seriation/0000755000176200001440000000000014201253523012244 5ustar liggesusersseriation/NAMESPACE0000644000176200001440000000553614132374360013502 0ustar liggesusersuseDynLib(seriation) import("TSP") import("grid") import("registry") importFrom("graphics", "plot", "text", "title") importFrom("stats", "reorder", "as.dist", "hclust", "runif", "rnorm", "as.dendrogram", "as.hclust", "nobs", "order.dendrogram", "heatmap", "cmdscale", "prcomp", "cor", "cor.test", "dist") export( bertinplot, bertin_cut_line, ggbertinplot, criterion, dissplot, ggdissplot, get_method, get_order, get_rank, get_permutation_matrix, panel.bars, panel.circles, panel.rectangles, panel.tiles, panel.squares, # deprecated panel.blocks, # deprecated panel.lines, permute, ser_permutation, ser_permutation_vector, permutation_matrix2vector, permutation_vector2matrix, seriate, is.robinson, random.robinson, pimage, ggpimage, hmap, gghmap, path_dist, VAT, iVAT, ggVAT, ggiVAT, create_lines_data, create_ordered_data, orderplot, uniscale, bluered, greenred, reds, blues, greens, 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_tsne, register_umap, register_optics, 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(ggpimage, matrix) S3method(ggpimage, 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(seriate, data.frame) S3method(reorder, hclust) S3method(summary, ser_permutation) S3method(summary, ser_permutation_vector) seriation/README.md0000644000176200001440000001222514201240306013520 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 Method The following methods are available for dissimilarity data: * ARSA - Simulated annealing (linear seriation) * 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 * GW - Hierarchical clustering reordered by Gruvaeus and Wainer heuristic * HC - Hierarchical clustering (single link, avg. link, complete link) * Identity permutation * MDS - Multidimensional scaling (metric, non-metric, angle) * OLO - Hierarchical clustering with optimal leaf ordering * OPTICS - Ordering points to identify the clustering structure. * QAP - Quadratic assignment problem heuristic (2-SUM, linear seriation, inertia, banded anti-Robinson form) * R2E - Rank-two ellipse seriation * Random permutation * Spectral seriation (unnormalized, normalized) * SPIN - Sorting points into neighborhoods (neighborhood algorithm, side-to-site algorithm) * TSP - Traveling sales person solver to minimize the Hamiltonian path length * TSNE - Order of the 1D t-distributed stochastic neighbor embedding (t-SNE) * UMAP - Order of the 1D embedding produced by uniform manifold approximation and projection * VAT - Order of the visual assessment of clustering tendency ordering A detailed comparison of the methods is available in the paper [An experimental comparison of seriation methods for one-mode two-way data.](http://dx.doi.org/10.1016/j.ejor.2016.08.066) (read the [preprint](https://michael.hahsler.net/research/paper/EJOR_seriation_2016.pdf)). The following methods are available 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 * [Reference manual for package seriation](https://www.rdocumentation.org/packages/seriation/) * 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. (read the [preprint](https://michael.hahsler.net/research/paper/EJOR_seriation_2016.pdf)) * [Seriation package vignette](https://cran.r-project.org/package=seriation/vignettes/seriation.pdf) with complete examples. 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+(gｃ: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_|Wｊğ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@fｊW+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). ME is not defined for matrices with negative values. \code{NA} is returned in this case. } \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. \doi{10.1287/opre.19.6.1350} 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. \doi{10.1080/10618600.2013.874295} 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. \doi{10.1016/j.ejor.2016.08.066} 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. \doi{10.1111/j.2044-8317.1976.tb00714.x} Hubert, L., P. Arabie, and J. Meulman (2001): \emph{Combinatorial Data Analysis: Optimization by Dynamic Programming.} Society for Industrial Mathematics. \doi{10.1137/1.9780898718553} Niermann, S. (2005): Optimizing the Ordering of Tables With Evolutionary Computation, \emph{The American Statistician,} \bold{59}(1), 41--46. \doi{10.1198/000313005X22770} 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. \doi{10.1287/opre.20.5.993} Robinson, W.S. (1951): A method for chronologically ordering archaeological deposits, \emph{American Antiquity,} \bold{16}, 293--301. \doi{10.2307/276978} 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. \doi{10.1186/1471-2105-9-155} } \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.Rd0000644000176200001440000000567614066707550015172 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 unidimensional 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/register_tsne.Rd0000644000176200001440000000235414132363703016174 0ustar liggesusers\name{register_tsne} \alias{register_tsne} \alias{tsne} \alias{tSNE} \title{Register Seriation Based on 1D t-SNE} \description{ Use t-distributed stochastic neighbor embedding (t-SNE) to create a seriation order. } \usage{ register_tsne() } \details{ Registers the method \code{"tsne"} for \code{seriate}. This method applies 1D t-SNE to data represented by a distance matrix and extracts the order from the 1D embedding. To speed up the process, an initial embedding is created using multi-dimensional scaling (MDS) which is improved by t-SNE. The \code{control} parameter \code{mds} controls if MDS is used to create an initial embedding. See \code{\link[Rtsne]{Rtsne}} to learn about the other available \code{control} parameters. \bold{Note:} Package \pkg{Rtsne} needs to be installed. } %\value{ %} \references{ van der Maaten, L.J.P. & Hinton, G.E., 2008. Visualizing High-Dimensional Data Using t-SNE. Journal of Machine Learning Research, 9, pp.2579-2605. } \seealso{ \code{\link{seriate}}, \code{\link[Rtsne]{Rtsne}} in \pkg{Rtsne}. } \examples{ \dontrun{ register_tsne() get_seriation_method("dist", "tsne") d <- dist(random.robinson(50, pre=TRUE, noise=.1)) o <- seriate(d, method = "tsne") pimage(d, o) } } \keyword{optimize} \keyword{cluster} seriation/man/hmap.Rd0000644000176200001440000001440114201234336014234 0ustar liggesusers\name{hmap} \alias{hmap} \alias{gghmap} \alias{heatmap} \title{Plot Heat Map Reordered Using Seriation} \description{ Provides heatmaps 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, scale = c("none", "row", "column"), showDend = TRUE, col = NULL, row_labels = NULL, col_labels = NULL, ...) gghmap(x, distfun = dist, method = "OLO", control = NULL, scale = c("none", "row", "column"), prop = FALSE, ...) } \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}). For \code{gghmap}, this parameter is passed on in \code{control}. } \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{scale}{character indicating if the values should be centered and scaled in either the row direction or the column direction, or none. Default is none.} \item{showDend}{ Show dendrograms in the margin? } \item{col}{a list of colors used.} \item{row_labels, col_labels}{ a logical indicating if row and column labels in \code{x} should be displayed. If \code{NULL} then labels are displayed if the \code{x} contains the appropriate dimname and the number of labels is 25 or less. A character vector of the appropriate length with labels can also be supplied. } \item{prop}{logical; change the aspect ratio so cells in the image have a equal width and height.} \item{\dots}{further arguments passed on to \code{\link{heatmap}} in package \pkg{stats}.} } \details{ For dendrogram based heat maps, the arguments are passed on to \code{heatmap} in \pkg{stats}. The following arguments for \code{heatmap} cannot be used: \code{margins, 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{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.} } } \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[stats]{heatmap}} in \pkg{stats}.} \author{Michael Hahsler} \examples{ data("Wood") # regular heatmap from package stats heatmap(Wood, main = "Wood (standard heatmap)") # Default heatmap does Euclidean distance, hierarchical clustering with # average-link and optimal leaf ordering hmap(Wood, main = "Wood (opt. leaf ordering)") # Heatmap shown without dendrograms (used pimage) hmap(Wood, main = "Wood (opt. leaf ordering)", showDend = FALSE) # 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, distfun = dist_cor, col = greenred(100), row_labels = FALSE, main = "Wood (reorded by corr. between obs.)") # Heatmap with order based on the angle in two-dimensional MDS space. hmap(Wood, method = "MDS_angle", col = greenred(100), row_labels = FALSE, main = "Wood (reorderd using ange in MDS space)") # Heatmap for distances d <- dist(Wood) hmap(d, method = "OLO", main = "Wood (Euclidean distances)") # order-based with dissimilarity matrices hmap(Wood, method = "MDS_angle", showdist = "both", col = greenred(100), col_dist = greens(100), keylab = "norm. Expression", main = "Wood (reporderd with distances)") # Manually seriate and plot as pimage. o <- seriate(Wood, method = "heatmap", control = list(dist_fun = dist, seriation_method = "OLO")) o pimage(Wood, o, prop = FALSE) # Note: method heatmap calculates reorderd hclust objects which can be used for many heatmap # implementations. heatmap(Wood, Rowv = as.dendrogram(o[[1]]), Colv = as.dendrogram(o[[2]])) # ggplot 2 version does not support dendrograms in the margin (for now) if (require("ggplot2")) { library("ggplot2") gghmap(Wood) + labs(title = "Wood", subtitle = "Optimal leaf ordering") # More parameters (see ? ggpimage): reverse column order and flip axes, make a proportional plot gghmap(Wood, reverse_columns = TRUE) + labs(title = "Wood", subtitle = "Optimal leaf ordering") gghmap(Wood, flip_axes = TRUE) + labs(title = "Wood", subtitle = "Optimal leaf ordering") gghmap(Wood, flip_axes = TRUE, prop = TRUE) + labs(title = "Wood", subtitle = "Optimal leaf ordering") gghmap(Wood, distfun = dist_cor) + labs(title = "Wood", subtitle = "Reorded by correlation between observations") + scale_fill_gradient2(low = "darkgreen", high = "red") gghmap(d, prop = TRUE) + labs(title = "Wood", subtitle = "Euclidean distances, reordered)") # Note: the ggplot2-based version cannot show distance matrices in the same plot. # Manually seriate and plot as pimage. o <- seriate(Wood, method = "heatmap", control = list(dist_fun = dist, seriation_method = "OLO")) o ggpimage(Wood, o, prop = FALSE) } } \keyword{hplot} seriation/man/dissplot.Rd0000644000176200001440000003046514154555662015177 0ustar liggesusers\name{dissplot} \alias{dissplot} \alias{ggdissplot} \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. Dissimilarity plots can be used to uncover hidden structure in the data and judge cluster quality. } \usage{ # grid-based dissimilarity plot dissplot(x, labels = NULL, method = "Spectral", control = NULL, lower_tri = TRUE, upper_tri = "average", cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, options = NULL, ...) # ggplot2-based dissimilarity plot ggdissplot(x, labels = NULL, method = "Spectral", control = NULL, lower_tri = TRUE, upper_tri = "average", cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, ...) } \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 single character string indicating the seriation method used to reorder the clusters (inter cluster seriation) as well as the objects within each cluster (intra cluster seriation). If different 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, if cluster labels are supplied, only coarse seriation). For intra cluster reordering with the special method \code{"silhouette width"} is available (for \code{dissplot only}). 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. A third list element (named \code{aggregation}) can be added to control 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{upper_tri, lower_tri}{ a logical indicating whether to show the upper or lower triangle of the distance matrix. The string "average" can also be used to display within and between cluster averages.} \item{cluster_labels}{ a logical indicating whether to display cluster labels in the plot.} \item{cluster_lines}{ a logical indicating whether to draw lines to separate clusters.} \item{reverse_columns}{ 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{options}{a list with options for plotting the matrix (\code{dissplot} only). \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{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}{\code{dissplot}: further arguments are added to \code{options}. \code{ggdissplot} further arguments are passed on to \code{\link{ggpimage}}.} } \details{ 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. \bold{Note:} Since \code{pimage} uses \pkg{grid}, it should not be mixed with base R primitive plotting functions, but the appropriate functions in \code{\link[grid]{grid-package}}. } \value{ \code{dissplot()} returns 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). \code{ggdissplot} returns a ggplot2 object representing the plot. } \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. \doi{10.1198/jcgs.2010.09139} Ling, R.F. (1973): A computer generated aid for cluster analysis. \emph{Communications of the ACM,} \bold{16}(6), 355--361. \doi{10.1145/362248.362263} 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. \doi{10.1016/0377-0427(87)90125-7} 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. \doi{10.1287/ijoc.15.2.208.14448} } \seealso{ \code{\link[grid]{grid-package}}, \code{\link[stats]{dist}}, \code{\link{seriate}}, \code{\link{pimage}} and \code{\link{hmap}}. } \author{Michael Hahsler} \examples{ data("iris") # shuffle rows x_iris <- iris[sample(seq(nrow(iris))), -5] d <- dist(x_iris) # Plot original matrix dissplot(d, method = NA) # Plot reordered matrix using the nearest insertion algorithm (from tsp) dissplot(d, method = "TSP", main = "Seriation (TSP)") # Cluster iris with k-means and 3 clusters and reorder the dissimality matrix l <- kmeans(x_iris, centers = 3)$cluster dissplot(d, labels = l, main = "k-means") # show only distances as lower triangle dissplot(d, labels = l, main = "k-means", lower_tri = TRUE, upper_tri = FALSE) # 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"), main = "K-Means + Seriation", 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, biased towards small distances plot(res, main = "K-Means + Seriation (red-blue + biased)", 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, main = "K-Means + Seriation (cubic + threshold)", zlim = c(0, 2), col = grays(100, power = 3), newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) # Use gray scale with logistic transformation plot(res, main = "K-Means + Seriation (logistic scale)", col = gray( plogis(seq(max(res$x_reordered), min(res$x_reordered), length.out = 100), location = 2, scale = 1/2, log = FALSE) ), newpage = FALSE) popViewport(2) # The reordered_cluster_dissimilarity_matrix object res names(res) # ggplot-based dissplot if (require("ggplot2")) { library("ggplot2") # Plot original matrix ggdissplot(d, method = NA) # Plot seriated matrix ggdissplot(d, method = "TSP") + labs(title = "Seriation (TSP)") # Cluster iris with k-means and 3 clusters l <- kmeans(x_iris, centers = 3)$cluster ggdissplot(d, labels = l) + labs(title = "K-means + Seriation") # show only lower triangle ggdissplot(d, labels = l, lower_tri = TRUE, upper_tri = FALSE) + labs(title = "K-means + Seriation") # No lines or cluster labels and add a label for the color key (fill) ggdissplot(d, labels = l, cluster_lines = FALSE, cluster_labels = FALSE) + labs(title = "K-means + Seriation", fill = "Distances\n(Euclidean)") # Diverging color palette with manual set midpoint and different seriation methods ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + labs(title = "K-Means + Seriation", subtitle = "biased color scale") + scale_fill_gradient2(midpoint = median(d)) # Use manipulate scale using package scales library("scales") # Threshold (using limit and na.value) and cubic scale to highlight differences cubic_dist_trans <- trans_new( name = "cubic", # note that we have to do the inverse transformation for distances trans = function(x) x^(1/3), inverse = function(x) x^3 ) ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + labs(title = "K-Means + Seriation", subtitle = "cubic + biased color scale") + scale_fill_gradient(low = "black", high = "white", limit = c(0,2), na.value = "white", trans = cubic_dist_trans) # Use gray scale with logistic transformation logis_2_.5_dist_trans <- trans_new( name = "Logistic transform (location, scale)", # note that we have to do the inverse transformation for distances trans = function(x) plogis(x, location = 2, scale = .5, log = FALSE), inverse = function(x) qlogis(x, location = 2, scale = .5, log = FALSE), ) ggdissplot(d, l, method = list(inter = "Spectral", intra = "MDS")) + labs(title = "K-Means + Seriation", subtitle = "logistic color scale") + scale_fill_gradient(low = "black", high = "white", trans = logis_2_.5_dist_trans, breaks = c(0, 1, 2, 3, 4)) } } \keyword{hplot} \keyword{cluster} seriation/man/criterion_methods.Rd0000644000176200001440000000545414055276717017060 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) get_criterion_method(kind, name) set_criterion_method(kind, name, fun, description = NULL, merit = NA, ...) ## deprecated show_criterion_methods(kind) } \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. If \code{kind} is missing, then a list of methods is returned. \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 # List all criterion calculation methods by type list_criterion_methods() # List methods for matrix list_criterion_methods("matrix") get_criterion_method("dist", "AR_d") # Define a new method (sum of the diagonal elements) ## 1. implement a function to calculate the measure criterion_method_matrix_foo <- function(x, order, ...) { if(!is.null(order)) x <- permute(x,order) sum(diag(x)) } ## 2. Register new method set_criterion_method("matrix", "DiagSum", criterion_method_matrix_foo, description = "Calculated the sum of all diagonal entries", merit = FALSE) list_criterion_methods("matrix") get_criterion_method("matrix", "DiagSum") ## 3. use all criterion methods (including the new one) criterion(matrix(1:9, ncol = 3)) } \keyword{misc} seriation/man/bertinplot.Rd0000644000176200001440000001654614154560651015516 0ustar liggesusers\name{bertinplot} \alias{bertinplot} \alias{ggbertinplot} \alias{bertin_cut_line} \alias{panel.bars} \alias{panel.circles} \alias{panel.lines} \alias{panel.tiles} \alias{panel.rectangles} \alias{panel.blocks} % deprecated \alias{panel.squares} % deprecated \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. Note that Bertin arranges the cases horizontally and the variables as rows. The matrix can be rearranged using seriation techniques to make structure in the data visible (see Falguerolles et al 1997). } \usage{ # grid-based plot bertinplot(x, order = NULL, panel.function = panel.bars, highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, ...) # ggplot2-based plot ggbertinplot(x, order = NULL, geom = "bar", highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, prop = FALSE, ...) } \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{panel.function}{ a function to produce the symbols. Currently available functions are \code{panel.bars} (default), \code{panel.circles}, \code{panel.rectangles}, \code{panel.tiles} 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{geom}{ visualization type. Available geometries are: "tile", "rectangle", "circle", "line", "bar", "none".} \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{row_labels, col_labels}{ a logical indicating if row and column labels in \code{x} should be displayed. If \code{NULL} then labels are displayed if the \code{x} contains the appropriate dimname and the number of labels is 25 or less. A character vector of the appropriate length with labels can also be supplied. } \item{flip_axes}{logical indicating whether to swap cases and variables in the plot. The default (\code{TRUE}) is to plot cases as columns and variables as rows.} \item{prop}{logical; change the aspect ratio so cells in the image have a equal width and height.} \item{...}{ \code{ggbertinplot}: further parameters are passed on to \code{\link{ggpimage}}. \code{bertinplot}: further parameters can include: \describe{ \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}. \code{ggbertinplot} calls \code{ggpimage} and all additional parameters are passed on. } %\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, panel = panel.tiles, shading_col = bluered(100), highlight = FALSE) bertinplot(x, order, panel = panel.circles, spacing = -.2) bertinplot(x, order, panel = panel.rectangles) bertinplot(x, order, panel = panel.lines) # 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, 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) # ggplot2-based plots if (require("ggplot2")) { library(ggplot2) # Default plot uses bars and highlighting values larger than the mean ggbertinplot(x, order) # highlight values in the 4th quartile ggbertinplot(x, order, highlight = quantile(x, probs = .75)) # Use different geoms. "none" lets the user specify their own geom. # Variables set are row, col and x (for the value). ggbertinplot(x, order, geom = "tile", prop = TRUE) ggbertinplot(x, order, geom = "rectangle") ggbertinplot(x, order, geom = "rectangle", prop = TRUE) ggbertinplot(x, order, geom = "circle") ggbertinplot(x, order, geom = "line") # Tiles with diverging color scale ggbertinplot(x, order, geom = "tile", prop = TRUE) + scale_fill_gradient2(midpoint = mean(x)) # Custom geom (geom = "none"). Defined variables are row, col, and x for the value ggbertinplot(x, order, geom = "none", prop = FALSE) + geom_point(aes(x = col, y = row, size = x, color = x > 30), pch = 15) + scale_size(range = c(1, 10)) # Use a ggplot2 theme with theme_set() old_theme <- theme_set(theme_minimal() + theme(panel.grid = element_blank()) ) ggbertinplot(x, order, geom = "bar") theme_set(old_theme) } } \keyword{hplot} \keyword{cluster} seriation/man/colors.Rd0000644000176200001440000000371214066707424014627 0ustar liggesusers\name{color_palettes} \alias{greenred} \alias{bluered} \alias{grays} \alias{greys} \alias{reds} \alias{blues} \alias{greens} \title{Different Useful Color Palettes} \description{ Defines several color palettes for \code{pimage}, \code{dissplot} and \code{hmap}. } \usage{ grays(n, bias = 1, power = 1, ...) greys(n, bias = 1, power = 1, ...) reds(n, bias = 1, power = 1, ...) blues(n, bias = 1, power = 1, ...) greens(n, bias = 1, power = 1, ...) bluered(n, bias = 1, power = 1, ...) greenred(n, bias = 1, power = 1, ...) } \arguments{ \item{n}{ number of different colors produces. } \item{power}{ used to control how chroma and luminance is increased (1 = linear, 2 = quadratic, etc.)} \item{bias}{ a positive number. Higher values give more widely spaced colors at the high end. } \item{...}{ further parameters are passed on to \code{\link{sequential_hcl}} or \code{\link{diverging_hcl}}.} } \details{ The color palettes are created with \code{sequential_hcl} and \code{diverging_hcl} from package \pkg{colorspace}. The two sequential palettes are: \code{reds} and \code{grays} (or \code{greys}). The two diverging palettes are: \code{bluered} and \code{greenred}. } \value{ A vector with \code{n} colors. } \seealso{ \code{\link[colorspace]{sequential_hcl}}, \code{\link[colorspace]{diverging_hcl}}, \code{\link{pimage}}, \code{\link{dissplot}}, \code{\link{hmap}}. } \author{Michael Hahsler} \examples{ m <- outer(1:10,1:10) m pimage(m) pimage(m, col = greys(100, power = 2)) pimage(m, col = greys(100, bias = 2)) pimage(m, col = bluered(100)) pimage(m, col = bluered(100, power = .5)) pimage(m, col = bluered(100, bias = 2)) pimage(m - 25, col = greenred(20, bias = 2)) ## choose your own color palettes library(colorspace) hcl_palettes(plot = TRUE) ## blues (with 20 shades) pimage(m, col = colorspace::sequential_hcl(20, "Blues", rev = TRUE)) ## blue to green (aka "Cork") pimage(m, col = colorspace::diverging_hcl(100, "Cork")) } \keyword{hplot} seriation/man/Chameleon.Rd0000644000176200001440000000252014066706151015211 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 algorithm 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. \doi{10.1109/2.781637} 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. \doi{10.1109/TKDE.2011.33} } \examples{ data(Chameleon) plot(chameleon_ds4, cex = .1) } \keyword{datasets} seriation/man/permute.Rd0000644000176200001440000000545714066706151015013 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, lists, dendrograms (also \code{hclust} objects), the order of observations in a \code{dist} object, the rows and columns of a matrix or data.frame, and 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 matrix-like objects, the additional parameter \code{margin} can be specified to permute only a single dimension. In this case, \code{order} can be a single permutation vector or a complete liis with pemutations for all dimensions. In the latter case, all permutations but the one specified in \code{margin} are ignored. For \code{dendrograms} and \code{hclust}, subtrees are rotated to represent the order best possible. If the order is not achieved 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{ # List data types for permute methods("permute") # Permute matrix m <- matrix(rnorm(10), 5, 2, dimnames = list(1:5, LETTERS[1:2])) m # Permute rows and columns o <- ser_permutation(5:1, 2:1) permute(m, o) ## permute only columns permute(m, o, margin = 2) df <- as.data.frame(m) permute(df, o) # 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.Rd0000644000176200001440000000557114055276064017052 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) get_seriation_method(kind, name) set_seriation_method(kind, name, definition, description = NULL, control = list(), ...) ## deprecated show_seriation_methods(kind) } \arguments{ \item{kind}{the data type the method works on. For example, \code{"dist"}, \code{"matrix"} or \code{"array"}. If missing, then methods for any type are shown. } \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. If \code{kind} is missing, then a list of methods is returned. \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 # List all seriation methods by type list_seriation_methods() # List methods for matrix seriation list_seriation_methods("matrix") get_seriation_method(name = "BEA") # Example for defining a new seriation method (reverse identity function for matrix) # 1. Create the seriation method seriation_method_reverse <- function(x, control) { # return a list of order vectors, one for each dimension list(seq(nrow(x), 1), seq(ncol(x), 1)) } # 2. Register new method set_seriation_method("matrix", "Reverse", seriation_method_reverse, description = "Reverse identity order", control = list()) list_seriation_methods("matrix") get_seriation_method("matrix", "reverse") # 3. Use the new seriation methods seriate(matrix(1:12, ncol=3), "reverse") } \keyword{misc} seriation/man/register_umap.Rd0000644000176200001440000000167014132363703016165 0ustar liggesusers\name{register_umap} \alias{register_umap} \alias{umap} \title{Register Seriation Based on 1D UMAP} \description{ Use uniform manifold approximation and projection (UMAP) to embedd the data on the number line and create a seriation order. } \usage{ register_umap() } \details{ Registers the method \code{"umap"} for \code{seriate}. This method applies 1D UMAP to data represented by a distance matrix and extracts the order from the 1D embedding. \bold{Note:} Package \pkg{umap} needs to be installed. } %\value{ %} \references{ McInnes, L, Healy, J, UMAP: Uniform Manifold Approximation and Projection for Dimension Reduction, ArXiv e-prints 1802.03426, 2018 } \seealso{ \code{\link{seriate}}, \code{\link[umap]{umap}} in \pkg{umap}. } \examples{ \dontrun{ register_umap() get_seriation_method("dist", "umap") d <- dist(random.robinson(50, pre=TRUE, noise=.1)) o <- seriate(d, method = "umap") pimage(d, o) } } \keyword{optimize} \keyword{cluster} seriation/man/Zoo.Rd0000644000176200001440000000302113735122777014072 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{https://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.Rd0000644000176200001440000000451114066707011015266 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 ignored 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.Rd0000644000176200001440000002070514154554312014563 0ustar liggesusers\name{pimage} \alias{pimage} \alias{pimage.matrix} \alias{pimage.dist} \alias{ggpimage} \alias{ggpimage.matrix} \alias{ggpimage.dist} \title{Permutation Image Plot} \description{ Provides methods for matrix shading, i.e., displaying a color image for matrix (including correlation matrices) and \code{dist} objects given an optional permutation. The plot arranges colored rectangles to represent the matrix value. Columns and rows appear in the order in the matrix. This visualization is also know asi a heatmap. Implementations based on the \pkg{grid} graphics engine and based n \pkg{ggplot2} are provided. } \usage{ # grid-based image plot pimage(x, order = NULL, col = NULL, main ="", xlab = "", ylab = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ..., newpage = TRUE, pop = TRUE, gp = NULL) # ggplot2-based image plot ggpimage(x, order = NULL, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE) } \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{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{keylab}{ 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{row_labels, col_labels}{ a logical indicating if row and column labels in \code{x} should be displayed. If \code{NULL} then labels are displayed if the \code{x} contains the appropriate dimname and the number of labels is 25 or less. A character vector of the appropriate length with labels can also be supplied. } \item{prop}{logical; change the aspect ratio so cells in the image have a equal width and height.} \item{flip_axes}{logical; exchange rows and columns for plotting.} \item{reverse_columns}{logical; revers the order of how the columns are displayed.} \item{\dots}{further arguments are ignored. } \item{newpage, pop, gp}{Start plot on a new page, pop the viewports after plotting, and use the supplied \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 rows the y-coordinates (in reverse order). If \code{x} is of class \code{dist} it is converted to full-storage representation before plotting. \bold{Grid-based plot:} The viewports used for plotting are called: \code{"plot"}, \code{"image"} and \code{"colorkey"}. \emph{Note:} Since \code{pimage} uses \pkg{grid}, it should not be mixed with base R primitive plotting functions, but the appropriate functions in \code{\link[grid]{grid-package}}. \bold{ggplot2-based plot:} A ggplot2 object is returned. Colors, axis limits and other visual aspects can be added using standard ggplot2 functions (\code{labs}, \code{scale_fill_continuous}, \code{labs}, etc.). } \seealso{ \code{\link[grid]{grid-package}}, \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 for logical values. TRUE values are dark and no color key is shown. There are too many # Row labels (>25) so they are suppressed. pimage(x) # Show all labels and flip axes or reverse columns pimage(x, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE) pimage(x, row_labels = TRUE, col_labels = TRUE, reverse_columns = TRUE) # Reorder matrix, use custom colors, and add a title. pimage(x, order = seriate(x), row_labels = TRUE, col_labels = TRUE, col = c("white", "red"), main = "Random Data (Reordered)") # Show a reordered distance matrix (distances between rows). # Dark means low distance. The aspect ratio is automatically fixed to 1:1. # The upper triangle is suppressed triangle d <- dist(x, method = "binary") pimage(d, order = seriate(d), main = "Random Data (Distances)") # Show only distances that are smaller than .5 using limits on z. pimage(d, order = seriate(d), main = "Random Data (Distances + Theshold)", zlim = c(0, .5)) # Add to the plot using functions in package grid library("grid") pimage(x, pop = FALSE) ### pop = FALSE allows us to manipulate viewports downViewport(name = "image") # Highlight cell column 7 (G) / row 5 (from top)/col with a red arrow starting at 5/2 # Note: columns are x and rows are y. grid.lines(x = c(5, 7), y = c(2, 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, widths = unit(c(.4, .6), unit = "npc")))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) ## seriate matrix o <- seriate(x) pimage(x, o, labCol = FALSE, main = "Random Data", newpage = FALSE) upViewport(1) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) ## add the reordered dissimilarity matrix for rows d <- dist(x) pimage(d, o[[1]], main = "Distances", newpage = FALSE) upViewport(1) popViewport(0) ## ggplot2 Examples if (require("ggplot2")) { x <- matrix(sample(c(FALSE, TRUE), 300, rep = TRUE), ncol = 10, dimnames = list(1:30, LETTERS[1:10])) # Matrix for logical values. TRUE values are dark. There are too many # Row labels (>25) so they are suppressed. ggpimage(x) # Show all labels and flip axes or reverse columns ggpimage(x, flip_axes = TRUE, row_labels = TRUE, col_labels = TRUE) ggpimage(x, reverse_columns = TRUE, row_labels = TRUE, col_labels = TRUE) # Add lines ggpimage(x) + geom_hline(yintercept = seq(0, nrow(x)) + .5) + geom_vline(xintercept = seq(0, ncol(x)) + .5) # Reorder matrix, use custom colors, add a title, # and hide colorkey. ggpimage(x, order = seriate(x), row_labels = TRUE, col_labels = TRUE) + scale_fill_manual(values = c("grey90", "red")) + theme(legend.position = "none") + labs(title = "Random Data") # Show a reordered distance matrix (distances between rows). # Dark means low distance. d <- dist(x, method = "binary") ggpimage(d, order = seriate(d)) + labs(title = "Random Data", subtitle = "Distances") # Show also upper triangle ggpimage(d, order = seriate(d), upper_tri = TRUE) + labs(title = "Random Data", subtitle = "Distances") # Show only distances that are smaller than .5 using limits on fill. ggpimage(d, order = seriate(d)) + labs(title = "Random Data (Distances + Theshold)") + scale_fill_gradient(low = "darkblue", high = "lightgray", limit = c(0, .5), na.value = "white") # Use ggplot2 themes with theme_set old_theme <- theme_set(theme_linedraw()) ggpimage(d, order = seriate(d)) + labs(title = "Random Data (Distances)") theme_set(old_theme) # Use custom color palettes: Gray scale, Colorbrewer (provided in ggplot2) and colorspace ggpimage(d, order = seriate(d), upper_tri = FALSE) + scale_fill_gradient(low = "black", high = "white", na.value = "white") ggpimage(d, order = seriate(d), upper_tri = FALSE) + scale_fill_distiller(palette = "Spectral", direction = +1, na.value = "white") ggpimage(d, order = seriate(d), upper_tri = FALSE) + colorspace::scale_fill_continuous_sequential("Reds", rev = FALSE, na.value = "white") } } \keyword{hplot} seriation/man/dissimilarity.Rd0000644000176200001440000001364314066707011016210 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 correlation 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 associated 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. \emph{IEEE Transactions on Pattern Analysis and Machine Intelligence} 38(5):833-48. \doi{10.1109/TPAMI.2015.2470671} } \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 where reverse orders are ## also considered. ds <- ser_dist(os) hmap(ds, margin = c(7,7)) ## Compare using correlation between orders. Reversed orders have ## negative correlation! cs <- ser_cor(os, reverse = FALSE) hmap(cs, margin = c(7,7)) ## Compare orders by allowing orders to be reversed. ## Now all but random and identity are highly positive correlated cs2 <- ser_cor(os, reverse = TRUE) hmap(cs2, margin=c(7,7)) ## A better approach is to align the direction of the orders first ## and then calculate correlation. os_aligned <- ser_align(os) cs3 <- ser_cor(os_aligned, reverse = FALSE) hmap(cs3, margin = c(7,7)) ## Compare the orders using clustering. We use Spearman's foot rule ## (Manhattan distance of ranks). In order to use rank-based method, ## we align the direction of the orders. os_aligned <- ser_align(os) ds <- ser_dist(os_aligned, 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.Rd0000644000176200001440000000314114066707176015131 0ustar liggesusers\name{uniscale} \alias{uniscale} \alias{orderplot} \title{Unidimensional Scaling from Seriation Results} \description{ Performs (approximate) unidimensional scaling by first performing seriation to obtain a permutation and the using the permutation to calculate 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. \doi{10.1002/9781118445112.stat06462.pub2} } \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_optics.Rd0000644000176200001440000000201214132375240016512 0ustar liggesusers\name{register_optics} \alias{register_optics} \alias{optics} \alias{OPTICS} \title{Register Seriation Based on OPTICS} \description{ Use ordering points to identify the clustering structure (OPTICS) to create a seriation order. } \usage{ register_optics() } \details{ Registers the method \code{"optics"} for \code{seriate}. This method applies the OPTICS ordering algorithm to create an ordering. \bold{Note:} Package \pkg{dbscan} needs to be installed. } %\value{ %} \references{ Mihael Ankerst, Markus M. Breunig, Hans-Peter Kriegel, Joerg Sander (1999). OPTICS: Ordering Points To Identify the Clustering Structure. ACM SIGMOD international conference on Management of data. ACM Press. pp. 49-60. \doi{10.1145/304181.304187} } \seealso{ \code{\link{seriate}}, \code{\link[dbscan]{optics}} in \pkg{dbscan}. } \examples{ \dontrun{ register_optics() get_seriation_method("dist", "optics") d <- dist(random.robinson(50, pre=TRUE, noise=.1)) o <- seriate(d, method = "optics") pimage(d, o) } } \keyword{optimize} \keyword{cluster} seriation/man/register_DendSer.Rd0000644000176200001440000000415514132342165016547 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 different 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() get_seriation_method("dist", "DendSer") 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.Rd0000644000176200001440000000566214132342114015510 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"}}{ probaility 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 permutations. 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 \doi{10.18637/jss.v053.i04}. } \author{ Michael Hahsler } \seealso{ \code{\link{seriate}}, \code{\link[GA]{ga}} in \pkg{GA}. } \examples{ \dontrun{ register_GA() get_seriation_method("dist", "GA") 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.Rd0000644000176200001440000000546214073107336013756 0ustar liggesusers\name{VAT} \alias{path_dist} \alias{iVAT} \alias{VAT} \alias{ggiVAT} \alias{ggVAT} \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{ path_dist(x) VAT(x, upper_tri = TRUE, lower_tri = TRUE, ...) iVAT(x, upper_tri = TRUE, lower_tri = TRUE, ...) ggVAT(x, upper_tri = TRUE, lower_tri = TRUE, ...) ggiVAT(x, upper_tri = TRUE, lower_tri = TRUE, ...) } \arguments{ \item{x}{a \code{dist} object.} \item{upper_tri, lower_tri}{ a logical indicating whether to show the upper or lower triangle of the VAT matrix. } \item{...}{further arguments are passed on to \code{\link{pimage}} for the regular plots and \code{\link{ggpimage}} for the ggplot2 plots.} } \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{ggpimage}}, \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, main = "VAT for Lines") ## same as: pimage(d, seriate(d, "VAT")) ## ggplot2 version if (require("ggplot2")) { ggVAT(d) + labs(title = "VAT") } ## create iVAT which shows visually the three lines iVAT(d, main = "iVAT for Lines") ## same as: ## d_path <- path_dist(d) ## pimage(d_path, seriate(d_path, "VAT for Lines")) ## ggplot2 version if (require("ggplot2")) { ggiVAT(d) + labs(title = "iVAT for Lines") } ## compare with dissplot (shows banded structures and relationship between ## center line and the two outer lines) dissplot(d, method = "OLO_single", main = "Dissplot for Lines", col = bluered(100, bias = .5)) ## compare with optimally reordered heatmap hmap(d, method = "OLO_single", main = "Heatmap for Lines (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.Rd0000644000176200001440000000352114055506073016343 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: \itemize{ \item \code{"OLO"} (optimal leaf ordering; Bar-Joseph et al., 2001) and \item \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/DESCRIPTION0000644000176200001440000000377014201253522013760 0ustar liggesusersPackage: seriation Type: Package Title: Infrastructure for Ordering Objects Using Seriation Version: 1.3.2 Date: 2022-02-10 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). Hahsler et al (2008) . 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: stats, grDevices, grid, TSP, qap, cluster, gclus, colorspace, MASS, registry Suggests: DendSer, GA, Rtsne, dbscan, umap, testthat, dendextend, ggplot2, scales 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: 2022-02-10 16:44:11 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: 2022-02-10 18:20:02 UTC seriation/build/0000755000176200001440000000000014201240332013335 5ustar liggesusersseriation/build/vignette.rds0000644000176200001440000000033714201240332015677 0ustar liggesusersuQQ 0, !C BCCgI\Ho,]upcG!e`MHM 78ɜ\ V\o8r%EzKZQ3#1)ir'Feih&(ߥ#+4\L -V|5<11hON!šU&3k(k5iَX %'/VBaׯ6H!9xo˯muڼi{ [Y {ģtlպS[$m=Zi[c1n nP1%T6C,͐Je3$YJEο$)-~ -/*xZ!qItCmL7YtCP2 ilmdawkg%҈")H͒\J҈Ьd䬲% `;p'm!f ]w_$Tnɕv 6o}V[r=V^٭3wyWr0}).9啂d-zQ렯Weo&^"}6# E!v벳*.#`~m{V:E=U*~m+VnЭlMHd>@:y-Y%ck=[+9>,9299bV1ǫ(Iq̳tsoE+'AXoQ]K޷^EWi~Nԃ1uMedL88;rRiâoiݡchM/>DK> #U9.χÇ۫χ ;χÇsj> P#h*T( UcPcUchcVcPcFU8ZP@7-g!d8eNhkVGT剟n?q˖?k[Ofgs-.Rds L` R+rijhh9oyɕJsW+n+eϹżkuZxАyܲP1~;x [͆reHttlTHs&#ģ*O{4s?[4 ޫ,zi/,FxmfU? ؞eWoƞUpl6p/P{3dܹsr JP$o}>ThݘmJ+1n\tg ?( CU$s1}J[;WRSd0 :Ryra~S~%_\/[44hΟ˽^\'9pfd 9`pfddxrh43qeX\ٙ[sOb6 lݶt-XYmlڅeͦ{Cxn UR4h:`|565K>{4o-x'zC:^;oQ77ʟZS5_\(mKV,nuc.v+"f+FP;VMU}kۂ_sjU_.L_jv5d>tTGݽ۷[+&P,yY]pu.s;fbVk1E-bn՞v}`p`=ʈCEӓ 6\Wk,-9Y.]+T%s羶sǯXy6C"@ {VI*SLIV3Z-c%~yYEzռ[6;ehl8_46hc4T"1 @1 vۀ~ #&LC>w@G[42268xetT:PC/ejGȳnq$36S 5T_eYe[.>C뿢uw.>#hWe4djLoh|j۳Yi3aHf3F\?n Nbn5Tex[oݛ}1n̦= J?ɖ| Nn9Yw/Ͳ62#c'Acһ` |w m^5^Z粒6{I~m½˶Wڪ5+ C/*~x൮PHzc'!!b+ߞ' W5{ߴ7/d=]M^ٲ`;>ov,KQ轾Z9J5֭%gkCR}c˺V T_ض[zx`Q|ioM s׶)+nԪ."ݲ[*g`mVw`(ZVtK`PWn`E=9bl4pB)PHz vy_ׄ 9Efo9gIxL^y~+}4Qߐ#NM8P kK)}Ҫ /!}kCU˺ܤ[5Zܸ^ݳ=n0dY=-B>۵HXrMŷvWu_zEl`&/U瞧h#p 8hϪ{ֱi;9:,sؕq#/hxdw5Qgb[̯5jI'Vؠvv^o۞m^E|guMS lĹFaz]_pauvYȽ_w=^ gwYM;6_%ɶ,`BZ,z"x'o+M[{.Tgo,[h@(6mbp ~rYآl^qe-؇D-쫠"E+*H$mA}._S/&Z_?;2q Rm'βwb%B~&P4xnOƟ~_mU|o_<{h.P8gFWSooN'o2 }:@N]ox:<3T)BZS/4Y쏄V9X?9g%|矅D:^Sձ7NyclZ/}vfjI5jӠU0hܚy̭^g" }wfn0hŗ$®M:w*#q* ߮aFu6dju5!=M2hga<ȄT[<?`iSV}swM rH\l[3kg<6 NC|{89ou+jqL4u&H@ @/؆iV8Z$#|#yZN'g1$[2/TYo1wBtθl ۑam%. jB>ˉ?31 RcHD%Ӳ?wKS2ӗwT~וڴ0LF՛ו=[MKU]RcH*j)βA4!B!nPcH4{j)Xeω=%זĝp@ Bv ?" C]y֚lċVR`Iو5]jDp/ln܊do#fߔJ/Oy{k U`ಯ讳{f?јMx Q6]v% VB7~VsicK.I2-%LH;D3I)bg\@<4+MK^}Y[tD\j ໠fewۢH[d"_L+ˬgbe{A뻂ԻU@;<6+YwT6NITqC"EtvWT|xOiڡM@ilepφٝ&A'UXj^lܝ!)` tJ[1>9 c+,xXUmзL_mJay6sE-ZeJ!0*|>\(/[ !@f07&QJQbůzv/F5wG!2i}6%imsKk`Pw>_G鄭'[mV@}$hc/ LN_ѩwģ=py/V`&Ĺ͵S@Jp'QHTmw7%L8ɼ2=k+9JqES0wjy-իL^lO=n&LZ>in6|66 f^دi?ab Nq+4G LnC*dעCu-40SBKZ Z09_&>Yгڊ>_ 'ښbgY+sV *،T-_e%|պ"us_fjbɃ V5PcBaF=-k7Nfnv3{odjf(?}1EI2f5 U{> CPW!URn]{=?l@Y΅E١u72;NA;^h6٩*_Z*G1)ЧZ;k(bwmրffCŏkX5/#=E1(e(T|x͆pfkͲց{3sq"[f"\ Ohє*>b_nl1gڎΆ;mUgNV]_*΁ֶ1(|7g~my?ʳpAIBa˭&1`2dgO8${>bc޴*S& V*(4R:ΐ"я2"7NR OTAPij6 l.H--kj l0,/0&'DiQ [>{@Y U &8ЊI}C#4,,t/*'ŀ}Kld X&k2ltWS ʿ9{Cyjc{;Ij*%z-zU9Ttdit[WQ&( vvhu ~q<HtrthlZ ZqQ6Ȃ_Տ$x\8J 4v ]/"P/QRx m.^]hߎv{s iWbCh.nM?C&'3-sdO49,rm)w>Du;~y6֥ $E-߃fǴA2RTsTpDY)ҝr8>2Ñ^J8 6oWQFNjT_h|Q[UN1ZlC᪈’ǁ_f3ؒ nkI@-WɖU%gkȻ+f;6/^kiY5} "nCͥl9| [br肶G{龈@m7U#ĘloO;&J6пM$C0vMh'ֲ>Bs4";;xR!Cڢʨe8zXaue_x-+;M^Q]am²| 67(l4s2v&]\sfg̤pl!oCT|xF-akWn*,6pp/h-r]VQ&9ָR{*-/ߥ;ǃ9vPkltxd\~?ZHVp(3O•( $m9ۋ_]l[i;0i5 xh֨ja/^Ԣ3EO)*m;p=ڲ vu-*D\s,KK<:(.t+@<]^}&Ӈ#Bq~>gp+!nJr_~,xqdZY_IB!v+,Uf1.^2/O72jvh >B3Vg]6یeC{@iIVU<\˅tԤ5߷ NJVryEzP%wAէІO[W݋;?6}Fڕ0:N>6}&LmzN_8G53Үɪ8 Zm)J`;7{{Vs: W |!=] QЬ20M够!=à?T}#윃(М=&v ŦJwO:FmyNax|Z=KOߏ!6"pڒiYGc1k.$ fDښQ]i7-aZQvB?۬xx/B{ NVH~8}`Y!zGAU)7͡&3`[gUp7S̻VX"!O~~]Яͨlry67y_r9 UTpv<^QZN;(Kv9)K඿v|R(ol9/}GQMeѬcow:mnCCsXV϶PǠW"ơ9 )z8%Ntl"Qt&NغG889@#KnPB⺁i?( vxfx"-׺a=Xy@oÄu.&~S'^Rx}d`}5'=aC??P{-!<֛繏'ށfFlٳ^yڕ[=ڷQż]`gOS/VbLL** 'TS񴛍UЌ7H~+ Ωwe'r.` @DZ ,{`sX|BvT xE)d Y¢[ |h,AIv0:eLȪ12 IhS'*(Qm$u Y9YOn%b?,h 7ow񴛍ߎ!G֧k/Jqߑci'Al}z@R)FGRPeO!ײ ͊`0mf]IMuɕ7_?aҿj *\\rb`@9È(D'5zU]2Z%X8i f~wdi-Qt ,Nغ҅R8褔Ktp$Q%*8 ZV"*~L@pϓfU&ǯP.6q on'c-^uw,m~/&,]N؊=1.`~i@ n5_VEhFѯݛ.nbZel%e0NxuJJ49=,i0Ex _Evy(usfv|K:)~ZQIx^tɕMu'AO_)񴛍#J*uURS]wԸM߆r2O#o\1n}>Sѭ@#RZCI;vU1K)wP!j2F=X&”50|a%,sxw/߹ݒZu 3 )~k`KHE(\}A*xƿC?6o3_=(P ?`!=kLh%\nJ>RlZ.6ah]S9s׶% QK\vԢ]^ƼV6%۳UVQNjUV+[`\wU1dy.Jήtym֯5Lr_YѴG5^}͠Rq렯P7ģɆz?m Zk fm.7CIƒ )fۃa)pqn {inVAGJT,h*\ d$bi;}$*;a*4H}zu$:xҲUHGjr!Ty'g[Z.Ѫu˄Fm%s]@<-Tڲ#DzE<֏ce7ʖ f~#I!v ؞;_'<0u˩1:ΊTQJKi%vM@R**-?E[ }%blm3ͣLtS_^bBbxGFf uwOG}_.!+E\44?) =~/?# (˟ ]eC̊ݿ.񴛍?sWJSVv[ĩNJ~RGV fF7GyXwh{azJ%_LN\_#gAGOC"4H? 3mz¤߄@+MCvrNغtMDwIϠ3Vؓ,*/J+?$ (Пy" mgogCȿsϡ?ol>+s{"T\CʾȾD-/fO`-CW)LN;"Q#CIkЌ ey.J juKfosQ'V(\Lw߄soCO;OP$NԼVj .J'l7v?Һ},tܲB݁ aJ{-ٯ&? 7_Ab|"~y2/EP#Hl8A ɘ-0:~m񴛍?mNS tRT GAmjEG9t֙Azt޷y 0=.spp; H?* vBQe~\sq1 LWe-本U.<*. ]qoPNw\aQEc&_^cV~ "}r7@0S;3 j@eGcuQ=]-^0}I]fRjb>h9cBT pAuxi*e |[c9JXL,m0i1% vh"|TBj[a"Ä.DVڰ˙oh{V6k/-9Y6Qz;l!-зՋBzh̩Bq=5qOpl~Hh; 3ɒJϮuY+;t&zbD>#;i?QtfO(z?/ν("lY֤D&Zi1;yyilk7G#ߔ_c|D5o<]#h IHx gdwau(e脻Im Tpqe<7="IpDFJ 2<~)ݢB65|6{,XnѦyޒOI6)T4ӭPaI".SS-W**mh [[p | ,V>ɪ1x8 Z)[)c~͞$@ٳtN/V5:qK>vlGEboh<|Xh$DP-f?aidUN ż]%Lcc`Gԥ ?m1e+Nv_f`E5+P-ZѐU`(&SR:хLW)7s/Д GnmdNS ĂxinJz[Vb{G>ܦ.O8ޅ7mo~kh?BO Gu|ķ,2YݍTY~p ?$VK:?o؄}$zIKv޴ hk'C[;P^+ٲM8SZlf4 nGזK&%k#4$. [J#EnBY5fQɶ ~25[I){BPqFyr1]*`1vߚdwAH6=GX[-BzI;#?lŴs1Iv@= и#>17k2)0^ЈJ3m3>t8%:o# 妽(bG)*|N9v94rkՍb;G/ *rغaq"}#}W?7Knɐ6KE9Qzھ2j?݇MeCB5~eh^.V BxU][rND}U*" 7M18V X1b;8`XG #-CNjԣ!9ȇB ]#ٴԍR`Pf[GC0z,E=lLؾrhVɩvp~'qO8 c._ʴE\`rFF{eݖ.] '|PJb d}m:i:l]P ):RʯI֧<cмHτbX>*~K -)xZ::;B0JR-Pߤ"{9@ 6@5coahifX*f뵝-#!fGgDeDcVLP:44(D444W/<ˤ]y?ngp f߂9h|)P0J6Z;!FsxlUo0_S&`/ѫ-ɉT^ ?"mQ!vjBOI:@CuneWLh`By}7;KyKoivS<|P]+o~'9"9҆t!ԋ95#j~u1Y[:KxAX[:f!Ye+<,BMQu߬xRƝ靳'Z^ˉJ^NhJ2~JR'j=Ƭ?g`k%!mM^&sl<αˣ݇عi.|:0oo3JO{_Ŋ} zEugFR  gzb f U2rܚ{ҤX 荾um~gI(oʒr@>yr `|5oc|>h%jh(x3zC_NuZ5|7-(Pwᔅ+de>c.fw1暗V-o9vS-TzJǶ-y_5\⧻NiZ-eb]j|ꨦ~~#rNw5-gY~5vƎ7v\ͺŢ׽|K\.a !VBovƕ;Dh("$ؘ4ʆ}v?P}W_Q}V"grüNݶ9]۞]͔JyʢO?]ɖ mTUVfl[x%v/GAj:k5- H|?҄PqK iv+*s5SAKCdm\|JL %ՖF'ہBZcX<8W7ȕÙeL\Qhy֨ q{F ױjT&7l|Gh̲h"BcVDh1'56$qӴLWTiNT~if5D{f`1_űn:WNGnJ=힉N"BC!?o{i6LPȂٍ9-.)a?<Wc%B(fYy\^`5T*بSܒm51q]dH:FB}4f0z m1򻁿' [$~BP7HBVG.)u|Hv:Hr#^f엮G#10DB6? i/y^XwZi;o i31ˢ1Z1Ɯl͋yЩV 82TGL58UW0WVHnjV_LFg6坩VN| tXDğ=\D" +WNG!6] f;sCSSȀ&Muf;e:︼&=. :毮7=+bHd*8?eC\g= 5_ˮywyM6V3$ԺBE.VC&҄P;k~I~$1*n`HH2J2fʾZy{Te%!&tg\_z_4xeld"C1S^oϹJ7=CܦS*\zyV5q{oe;k=$.gbe '6>t+k751KLI2LGBșBАt_uϑceCZm̟c!M~@0z Ik|R,ۘp셲jKc'Ysidpe}?̈́ǯVm-2f؇+NF/rQ6+?x깋yr6eq}oh MX6(ltX6_algW'[Ǩ!463sYr|$9OahH'y!Lq՞۔{vmnvޕ ȘYMdqԊ1椦f$nNv@NU1pW]OwδZsOD>֗q:2 BvsrׄKeGc!t\cu#uظdXv>8e|2DHH: BxM',FtfCcx&Q:3³0JGSN  ˧!NC1] =:6<14:qyr"nt`sh>~h~ c}(!m|CxI6|afY40Q+ƘbmYɍS- ޾T+Uݧ+K"74FꍼݪYvQ8P{=BC!f_| _)ί`l;[YD|X o^ >VVu\5!Ax]۳MJSVVv+~~99Xv֨*Yw(pޥ 6l)#Ԅ6jr[&Wr] 8,Y"n{.tT0wiKs-8'/syݜn:S Ր }=:څ!!*X xivj=QqǁgBq##Ǐ&tL(C{ȥё108 J;"nO \T:o䍎[6\dbEfY4.2Q+EƘٛm9domZdf]&TJ7kW]i5_*'uK#iO{h06o0Z18ѴD{ICrnݪkM .d[cw( &{6H7؉oj]F8.7BilqKq"< !pg^:ܽ9J|S%Y spo|#`2UF`P y>?&gx[ҐeJj}8K"ñ<Jx_ob 5]i05%Lߔ>[%ҬVX ];=a\F}7 G<~{ X.XN>jܚ7Ứf P7 PQ$=ji_I>MqOE^kS&^HeoB0zEcѿM 7Www[/*܉~uk?CBih.G+Cs|okxbb|ўC*0C8T 2QKr]fLUvsr)}}kq|e4ј¨|Wu3ϟ鞭&PV3tnPhm'>ʖ#?kmXt׵Uݷ7~qZcjN6xmV8 4;-bp G{)$4&mSi[c5KbS@<-/ zw\:ߠ]B ǐPzH(her zWdr]ؤ z2ق"ܣdK2 Z`()nHoSeKR*ݐDw/.P6R-(]ϳH}.vG}x~l}àN9+d3"=7ģ(.]v% Vyt+Z\Y^N-BcG-Fgdwfp}?2_;rTJ۴=Dn- uxln GYctOI56?H\KE8gԊvI@3wgߑwqy8jVFA*'WCŹ)ޔP4;գ K|ܦD81[ƌ(kWg{.z>]vvCe"ģ*]I'Q4[!Jng$y+ ylou#c! v'(-+=.}vn7cYv.ˮ\st.Ypav;XAEY=4贶3we ~FEVˠ/llb6 (LniCI_O e?z a el}z3ݍ8,[Vi})7ֺ-tƄX9 <^cLO{!fwS\ۍF*xYgɱs؃bG| <l(L[@< %ma^b+b%J$ꈘЫpScӠc{1Dأ1dk8]T Rf达˳@2u}lYJk]`[~ų3l&d*+rbb/}kI`ٲĵTѥk %ɉ*bdm;ZwT\w ]iDZIE.'Ao\/!$))crDbˊNj` ]TU4Xԃ`9}v%wrG}A}mPq@n{ߥ>lL0+V84Jb9Zɶɋ0 :فK姀~#=P(V{n@V+ ܓnJ%K)q NybKKNֱT&:DlNnmJ^NZCqT)D8!єy}7_)۬d9ު#ٯXYRˤ2 rNVs˅FTqma'.]ʽ+<4҃%zA+櫑sqp&1JgBa슝}ŗd}Ncmy?!{m,Ifgy~/ )P=J=+Ur2EПQ-טl[@Rڒgg$C~]w:N9V\7ig3i(1)qHh%?N΂ oFA+-YP*>- [hyY-K^J{]rt#|Z 7d{tOul>dA4 h}'TS]OBOT7g2I(8ahAMxj0z˕poRi!w.H51 xC*'˄PicjRn)`vHBGKK=e%½6ԜO D?p'horP ]Vgj-&uXAyeIϮY2>P?v˔ȢL8&&'%xΒ-Vk |:\0]3a< _bZоՂPH9ۓ3%_Zi}j6@]JV7{63Z)ו؍qu$]ˤhX8 .i:R.Iσ_ˠ/`ȚbbjE3T= Gk$"CFB~ɏ Rvd< 3݆T8Zi[Sq[[yOV*I @ӟ$wx %m,Ka]X΀V FfN-$?y 6S6y7%Lyϐ*uT)  -aks{цdCisbZ [ $#Z1BO@+ zG?OٸdhIrK44WSbgI|>*u䠮Iljj{u#EY\rp6KglJ'ɏ]s }^L ME ONˌrk]6*kCs$/ϜqNA]~I8s 6S.XEs =ݠw^QCWR](~FBsNzN]슬L'$טRN~ѨLQ;p{xA\xȶA4!y6D:{,j@h| d7Ǔe3⚯-S  s&?k])x/Qqn_y϶YrvY=A ee4 R<,YK} 1'͒*P ςY6zJϰ;A5X)tE)?Qp_9-)}G!Si=Y?UQ'lxK;ܴm l9fJKVJT|xGmeA*w%7ڵ/x ZiXS6͒I-3GxhF㠕&J/-+(*xSrʮst牶mWk}օX^mv5VԣdG Z?}J\揁n KV>GZOT\7(T1qJGuI>Ltms[zu(#ģ*zaգHI~iJ%C {0깋֢ }旝aQ,Z'_l/쾵jy,֌>~ @-j^|EGhF=݇ejG.l&s[ ~5q~og|>h%jh(x;zCx6@7eZ ,M= tB]l_g21׼Rnyt;o:jM|~lۂ[W~)i+NeǬZ]vK֯ h[ޙnո,8KvojLoh|c`_ |K\.a`,Vt1z} ;xI!̈́,Io7l5.RxU/ljpw^ɞ 8I^_@ S|Sl hm1_@txQc/h۴o%F5ߗ @w aMfe}k۲]Jt(!f*啨+xP/p#Q۲h"ģ,} :J.92:v)6v,WYp7\9L6?DaDJ.hKqTLycSB6!Mw?bm@=mA91Gް3a$1ouiwU(TsWoR@7\g@r]k#SҬP:bJ4Op*{#43,cr_ li))m~oG{fo嶼=fC֥>R?>yއ;<M[<'֮c[/<>xL8{{+asnAp4:\D.W*kI(H-U|,gҬ`4(cYiVdLK`(h +# 5]~\:eR|^ G@h} [vWA fz,[qna,vx,+>'۫%~sF)tB+#OmHeGhƆ\q0,PȨY_luOGBsqf췀-BsfldݜfƪāB?  ^ n9b0V` W.o`X('L-T|xh8 vRߑw\=DCbٶ^[ DLɛZ '*_@Dz>Q\k*595S7~gZ;Ub ^y=#F~ѳm:G M#6nJӴԭ c5]nP{cH(ۗŲ %)amYv%:R!Cbȭg󩌝{7EX"')-(6MX/lܨK1$ts-\7Սܦڀ놰uW[pTx vݝO71mH>bPW,J)[m*a0bU&CFk{iX~mݒCwgXII'˼PГw&ɿ:yGIZ( ~_RJ7F,-]L Yl"l1*rve-SP:L@{Y-Q}B*LMe+ڇ G% Y 9zNl]w$GkT|x6$Tlv-{N:Ufs$F@3m6oDs4[vgG@[;fG/IWc7X'v5.bL6YTf l+ߓTݍɋjlWoBMf*심~fn)LO&_>tHíQ|4\*cV 2QsvAl"7kQvY`&_jp\JYCQ6 J@87*~ w[:%Q]yIt١yRl.L¦1, M|F GɵHo~ B;jO (7'VSSzxl *~(䢀x)ۅb7Ӡ'TxnO-?-'[Á\^.JD -TjfͶ(kAÉZ iǢ0sQϷ 6• }9>?]") t;B6WCyRhZCOP*C*kt,؅[_qJ+d8=|6{B#N'B'r!N,9i:Qq{A]NGTl_\uUo;)ɌUwDә2NOGA+U]8z6?@JI^ہ6E!VUVzxetGPr'[aNX/wjapGvuC6 f $jP]i4DHR+e)XG Žqr"Gg^XgmXrUǷ{û o -p/:a#ZE-ѦS֦KЦKզKZ s4ʒA8+6;c&AGIeH+8i$&,1LWe|2EWmAhySVơRRO:RF[R}s%iź "<]/XXC=报gIR`U \Kn~[mǮƳ n|bdyH3("?-*mѮ"2܈ɲ-_ ("a]NREWw %!mn7JIN%snAf(Z̈́J&q#ԩDu==Y*0 z sfIW. WiF3(DKhѲn~=a7x& Z\h`}mkrIAzcp[u>i='^ ŅYџި阦)@%O n8a_oR9 !lrFGTNCЧ[OT Kdc;LkB!AMQI<jmn*xI#%n3tLaU-)| Uvc4 В^j%Hiٌbς>~ @ş$E>pM#hv!x5SI Ad.PGt譮|N8>-?Ȋe=+e(3jCؠ]I\1j- @M O*7 @ZZt~rj#/kn»M1Vta Z߯BT}}.9m <V 'co#_h~NJȊ>|Z  ;-2#;/O/^8~;VVCj(( S\ Y[w%LT`xcpy7뇞T%˳NSmc3YW f2Nx.`sT^Cki'ݐT^!J뽜m ]j G â| (pCԹm-Š*Ƅ< bbXM3Vt헹r+O$\|\Щ3$q" hr"*0 :-}F{S4S"b(|洈MUNjChÖh,D8Ao=L2]m eSJx%~}I&f oF6UPTaV.Z#Ƭ\/pwBwѺA1 VSfS'<]+ko~5׌ٛ/1;w@` w8 ZOF!.~ށ푑wF$;ģ,[R,0ڛňQj:xt$bm/p?hrhL }yL" Yaŭ)&Jd\>40I.حaLBЯyS^4w6h [ i0$&+gQ *># y=aBoyųS^:} xҐ&g>QJ[xlih$sJ5D[h#*'hkX Ҭ_̰[Pz,H2 H(d#05a4duXNnRq@OOY\ߖ5uSO[oIQldo &|sVqw*R\:ʻ^BI) Cˉ!VwB u'*x:Н>@=镽&۝>@ttQ#qzxY;4}nE4 7U]˪݇P5ƒSStC@6RvTDs xұ^ytuyEJO+Ն Fǣ+SNroRUs5iU"NO>zUO>e_@0j;x-JRy8z=R9 =?L:)TxZFGPc逓P9I)XNQk{mtR>Y)jlS%I^_}0 Z- VӁ>~Ж>SWKֲ-ۍuVFut(h_Bѹ捲1.qd/[^#ZWeUx?| hҶoBվY}!fDz2M7քg@Ai JV%#N@+9y͇SG+PzS0pd6)UW[?fFӠ7荙T5t`8TgmX ,%YFq%6zR-:0 ד*p>hx>aM~u{QS5q20Ouic@݆]줙(v ѱ]T;ҵ\^`?d*Ũth<\hyriVJ8 h%AYJ+$rxycR%loC AG,A_Vv`K[WbcR@R9%y.h jv* M6'BVc]~s JEi4m%a @wOx-*~x.%f1l]ܲO/p]޸ٯj3*$蓭w1O>-R(I6\EFzo!C5w}=l22>XK'oz|!q\Q?بۗU{51Z*xZOlL2QAr*-m[^.c ΂6fboVZ3|QhiFžO9jmRѰ$VxT|xm>]vDxVx4[3llzkǯXyڍ۟0#cd_BB6}<~6-.󴈸>**QP벳~cl%[Wcc~grҭj{]lP5fG=F~Z(8Ó"tVy/6EI; 1.,mJWz$Ig[OV>?p>n0wׅggr9*-oLVMfzFiAy@Gv.:@yOo+y MekUBM~]wn )LTEYZd wK'p RWoHPtB3o[$Y $]4k\fD[W&;tgR v6%mS)01sx Of@i f+yhiyEeՌ8I@Jܪv8 zX[&W̩z/C_G7ƯXGe`d~fXY#+gX5yf2RsK4`r{$%y.1:y< hW|B,_^_=~x 5U}8ptT1ND' G-`oqQ* ]FTɢTh-aZcEjA.;ovkMWdJZK'V[5p/ZrpP%)K=Pk6tj$bcxLM?Hw+A*n7#:K"SirzDuw֏;IR;c1k J =lw 3r(TzCP,"dϲMӳmu%{awk5q|Zž'̺]ѮJ\+T`b!Y^)K_#.hAP=oi7?uo_B$6M^;X$LN3ttm>bр%b5Ȋoi.KMGK.(jE]v~"._G]ƙ֊A>pw*˰HJzOBdGvԎ4ڟb387opZv|Z^ТU#XԂPo̞>t^i(e'zпޠٳ bg?G~T@<52OOFI0*ǀ)]%[?gy§ 5 t봗Kekٞ^87?#OMM^{/r832_phd8322yeevVp83<926Swfgn=?![Ezo].o&ͤMY8Oi#I?u5 {S,Yܣ)R.Ռ-żh_6j4~GYܨ ⨩ݽPt=z嗬q}pgf+k^[)Ib[N5YS _*%۶-לvuԚV (oY/XY-4:_ȴݪkMYp,.ƎYXk15KԈ*[dZi6aISK:" !:]fX+lYNXMUk#J淃Q!CBRo)ꎝ3fe+#Ƒ hfTW~) \wB@+{ NHtÖJq\3ہA+-.¥ˣd.m Up nc+%K*\:`j&(l\|U̲h"bVU1'55$qSso:`DU.TL5U-ӝo3<׬v|ǰ,.}lX]p)b%.՞v-7TLf4,ZMS}U4R/T cg]/`4Ա^. {*ӍVkZQίvF'ëb%&kO4?v* oBKL64{ȏ+l^`F9;nZqJtON8!RF8z@hg݊2s vՈxςSaƜ}27;Ϫ"BQ՟KA;3Ε٘pϡUς>Jş)/sD}aé ݫ-T_3ہ_v21th&bfҥKqs6R'AK[F[ ױ^|5Sc" eD4GcNjoI&%zB-~^JT_u ?'9ݬvUׯhd\n9WNnjJL՞vBOTQ9fԴԾ۳YoROYpzc'߰DK]Q4{tW$4B<%}ǿ6W$eSs3qv@3VvsW- 9U]ͽӠ¬1  =҉ʩ3|=-9ǗGG@iOOVWw7p}FG < hG <X xtGvR.qq@+]e]^5Hx^zId4UPoT5mh#~[߆6~poCYCH* F <ڀV@!RܲRJ j{o߁:)j~HRG-TAƌm m[ymR@3;Pg!.!{ɮXv!Ӷ$shi= Vz1o;(-*xe' ?oȈP> ȴ'9x?_x։*eGh?>Rf{b,W&8! z6W7/HZ #oJy;۟$Ie*JoJoM469▦ɐyyM a?hZSM;t=k\YvhZ*{i8"ԻXHtI2t=֌0x"<Z$/?#4#g*~fUl̜b0W {~I](@\n*gO-H?WO? /x|B:nK EslL~1õ%Sӵ#QǠkW*'W&=Ͳvb΢NqHQf 0Iw:eGhF{-n)wWIK_\CIImv!/_?{~'*R7wgߑW?>(ܷ/ͻVUo]~$oo,%=YZrWpԝb7JMςBsSkpz%>Yi>hnTl<>'v%NKO%K.2$|%I3I'QKgJ x$̈́߅M=P^}?D1Pΰpjp*:%;[&3hWmX|ޞSo 4w?`sm`q3rqg 7~;9.ӀB}TP,/"`P}+h#4Jnj.?#@U0bv҈g(;B3"~ u=՟%-ml&?tC&Vt"jAkt zSt<V.0kf?[vW-/3?k j`ոoЮlKF ~+5 o~& vF' d1͈pAm2)G;92ʎKa !l5DB3JW|.?;E'iKGSR\"5' fUX0Zث ٫dTiPq=kWEQрk`rʎKa:!r/焝_eGhFę0JGv/9e~7 E K37(atFɷUZ<NWL0KIi[Fc%d|{@zCM|͋l!y\^P7p"!4a_ /P BCd#euw1=IJBwt670߃Bl>3p (;B36t8LʷNw݁{(;B3s Aj|1rcpIxHHdcO1SS\ߋ߃:k=A ɵ͎_EhnĽoQAI?pOx /3:eGhFI>vhZ@㍕ /߬*4>GQ`ѫMUqEf4;HhB1y;eOkTAUS2Io;modC.Yy2t V| N:2l4? o6t=MQ7s[D8Cmif=f?X}[BxhS7jDhnՈ3ze9B&6,8 ɜ䦭p\ub!BC=7C=$*+6 $P '%iBsK6 ZȘEk ~ynۍunL)8-ZVbn&9Ρbs;BniA/|/4peF?8e[&cW4:PI)aZ`)ߪmrbpd`u`1:BCVd8[o8amϳ/2\.s<fk3;&\ֵ+P 7(n: W#;cyd&E03^CP^<s| =ԮУx퓖W GsgWS`)GspVѫF.Dh.|. '4❫bsI5cue4Y4FoM>f.0ҥHb{7<_J `nfwpj,jvஐV;dѴm Ukrw&Cs nL{F!`aVUJ R!DxRk=j -~ :#z"`$ ww[/4Dv?׺[ >\L nXdPeVu;y/W5(_&;S<\ {qo&NYb.ft6jvJ^7b=vwmm0 um ydGrr{ .BKU|{צe^'ixOgoYĈ0zkp=f+܊6 8y ۀڧi[c5s?ىvɅ/ Crftoā6e'`Cu]q,[li8PL'ű"Ь8/[%+(8olCJ@ 1 l|∐+aDş! aXagm #ThΪ$[!-K/Ŕ YvIQ\.;f) Η V`#&u4hBSu F%&|vQo(*in\DGYv Bv|ڦWg[T֎Ez:2NLx4[@dj|UIhv[s82pof@VwSOK˨@i /n+40Zj8gL(_prIGAG.cǴ+Þ8>zl&^.g@h4l6T<%k2M[5 ̔h:!buC$ۻCm8zĘ^ !0i&A_7X[JcJ}C[}\gϺŲe;; zg;h垄ߢo@&Mnh}Z[.[AC /K$5K iog8 tUOhZ YT}%7wW#]H,p~d<;9P/ؕ..4_7:ҊE߷x+>t-àh gJ2춽dU)vsfNRT15 6To!h:h%?JOiB+˶o/VPc#^C >[LIHW-啹7a2%FOVST 7]=#﷿Qģca2%|64ޟy >^e> >e0jB"Eز]$zI$.軭WPf&yjڥT}H+} Lt"WV(舎Ј@) QH0:N H:I|m좸=.mo׋@z{s*4ǯZ uly6:ԯv&j'0zqnaP-z]V1h[xtm1MޗEdbpD54 h%=M'c8ѻLKQ vz`x%VLkL?-lqŽ£u˃A"aYZ]cQ9aV֭j1UX;McZ۱~A|}J;< ¡$~B;"Mdhf8l6f(ן )Ba3!;I< 33Wa*8pٲ.۷!3 =מj`˲ dsR(tx+x͆yJU9`tҘpfЧ2ߡb@B^")hm⧇I"`Rųk>4$iv +/LBs$Oa`tkclOID2#F|.M@)i/{6c'6vV LFA+%PiѦ>P)v'OX2-gyqJfm!g-',]N(h¤,m=.hQnzn=Cch B!nۅ-"ۛ%ծ7 Gќmeg}(B>p8a~eQqD-|ffְ#y)f#cҝ8N_X|;U7Cz2'5K +?ҁlO[Yu\":Ɂ3#F3#W.M 3|)nܚ{Sn)Чd+Ho7ccpM[X5S?80N{41KJ4V?54q塦:^;$o:bV-⨩ ߽PtLKV,׋9s14RnytϹj-bKcS.o3N״_jv5Zg>uTOe)wUϚG)%;7[LjLovլ[,| ^ʼXӠOk۳٦WGMbFmQ'bK@Ҍn_fT8 *mǰ!*2r I2}NgO4+oOgFRw 5~Br KO6_)$S@ IH⃄@Z*@)"WUoEueF>D ;Ao4vﶄ_W5^_M >\L ]W቉E{r2gU'C8$2Qú

+o7DD2(S7p!"B!SRE_t p%~GfNRrbvrv,/3~٫dy dS)z;˳G2U;j#wTnǂ,7%jdRȑO/6T ^"ģ, W i,c!#~ƴeBŷ^Y=nD';tIDذ*a(\f !f4Gm/atgo.)ƒj /)\\BPѹ\A_n\NЖ(ssR)ҩh YmƩK~D gQ~.Suc6q7P}0V6I+1M ) D95aB3ܢ <2̘dk;ABp6(PK=*K@uꩅYjv + M6R DgJHEMR In]vh+Nhߘu`vPNY{UlJYNV|jST=ϱ|=tmoC%G&''S8!SI< C!\@ ܪBPHܚe>ط"Xy]cD7QU?}J eXa&/gd s7lKCc×Fd8ĝ0M Uo1,[AziR"pOTiR5iRֽxI1ˢ4)8jEc83Ymi-mMR~/fIηҙV'f¬v5Zg4)1,KK߭z|]0a0ML?=Z D'*,)Rxmv ڵ]@$8'lC$86,& 0ZHsjW_J?Oqy84!w1A}%. ZԖt*뾹x kh&qǵT%qp"QMiflZ.vvLJPiii}!B3WjQ2hфƀ?S] 0. ؐ Cmo<14{uCZHua#I0H$žqUaLkCR f $hWFi3G7gZ]a$,/3XǞ"Pz:e"hMTGjpZϒUwpZcnf7gsSia58Q{!׻f^rvċ%_q^_ R~0b@H'+*~D꤅CLK/5T6I^$^Yhܦc =>X{D$jGVa^-M6)N/z8ƪEٴ|F2*+{j^_@6iIӕh~Dq/F6?CQTs@ 7,[ob 4oN%߈}KwY?(d :zu\9lAux}' ^N,B,\SWF7` wbb&Il}Ozkf}')b1:y.hi)c-;toJ2oR-쥸m= <|'l1pfDӿthmx{U E kee4FUWY'lr$=`ᢩ&*w?Po 3Qy#,o~5L/м՟- OE TԚd o[U2`۠o)xCT~`G1peb .Sw?=:;֡% E=ed"Eǰ5$sJý|l[ہjyC۽BLzCKW1+[űycPQɍŲ+ge)}_IW _JMݴHt֋mL}_[ԧt{BZW^+)np:x^7[ PlDw,\!IMhA?I#W-,7 xhj2yYuO [jZBVv;Cx[C[ V1]BlزL>v$ 8TDQSH!9 )NhwtnDug#^9vZLYN0K{Ci26V\5Ψtx!ӠFFtnR( h8zܘA)]΀i.oq% M6dfsCIs` Ś)8! þZzC}cl{0B{Jg3+ w/قn(Qc6 F^}F}C[وl&fwAm}SK(x ~B5)$P bL벓J)|C( ż^;V0 Wxk;J߁Akseޖ6Q:pY63ԬK'{xܛܛP܎c{bv?Sq} /,6w&'AyƧ+va)WTC~Y,6]D2\D$\]G.?uqc/Q:WtxhIHF7"tAڕ~. ]]q+AJ{/آ,A˫]/RrlQc7h~rű=5jGQ=xyZ|IJ2g2$C(:B3Y֤$W5n~-Ţ|p,Yp!;Ng0p:teX E_Z#`ܮdY}V BEA0SΜS}}jK` YϡWykhx VT\ 胭 15aB]Vؽl*ݍ_cN109|[~ųe> |6p KRm+%_{дHQjtni'n! Js+0^}E[vIhc3R䒆 ܏[ ;2CMS&wڄRy'&ф^͙]lpp8vh7H`iKt$W5IJfZ^ADpSx͆0itTV/ }j酐zZmkhI|ei-|  SMoy*ܪxʯ9ϻrQ^Pޖށx}Sz*[N>hg!k@ +2M):3P *4͔=mj6ڹt3] ,;YVevy(l ZCw>Bȣ#3R\bI]!Ziܴ>d{@d9y %i+Ԕ_.^hym9΍D8.Fpfuqfgt(newn~k"A~[ݙbÝw랴mc;A+]T\h@o qe۾f+S=? |IG ]hy~R\2`˞sh² ρV2r}^[RGYhekqyM|En$5;hM֎9iI%mkpYEhGRX XRVT-aCwE=HttTvPeܡǝ6;T\Pи#,vxض`9bj!ѩ3u uYJiܨ {렿wmQlCӝh[;x6Tz!S֏9T\?QDqiL;̳D~h)yn w)`ClF5C*S}nѱ+,Ld4ӭjnm) ςvӎP} I2>p7gs`:rO-o){GnF T҄IF=E*n2haFod޼S,0nc]x\ł!9tb0>:^6oƪM΅le>D>L< ﺯh3~O݌l0I:t}1Pv|*|{l.N;Jp؍_N1L]4ѶJH;lu*|hu۟О$qϞLRFT!`tZl#md @E,GAOEʺ^%}(16 ZLE]Yv$\f ل;jmI"v :.^?=ɒ~=fgM5%?u%B!6eAeݜK @~Lze9 F#v}sV89f '΋iν5!<A5KpQFcdcI/u- RI!vw`ڸqlI֑@is#=[ V3ץ! y6<`P/E.F }]J; d[yLb𦥒ۇ: ֽ7"iARW@_xh[ׁAth_%Z9h*thbhph%v)5zA+N yU:Ͼ$=t{7@fS9)Lχ+ ~XA aKj:v1ėEn{d[r)xEUle Èx_sp֥]+(:B3eiDV*˒f .{ ^}Yd-QE\v H)_. jq5p2 &bi2n` &tRYfL+iB! ẘ UX~Cw lY]=?'^%BqEVcBcE~E p?hm3 sn)IM}Jr8JTC{kX#Dh&:n`>xm(m4ę߼@,m2mRqj j;+]CH0Zii6pJV:*/!4h#=X 1.DqP+W|~, ǃv 437T3i4p`Fd*?=7@=#4;ـa%l߈F ?UVG5Tׇ3 t/+V ׷W(틈k%++uoB[%y9;-ӂU氲r/֋B~0EU?*>[ݗRj, UxĹ:7iBzV'PtV*¯-V{oFrc>*v 03r)xEAcYY9 <T{t6%YNhbpxZ܆onA}Z!/o.{Pzv)'ġ DLLž;k;\U?mHq E}֖V @|Mh;AL#x@$MQ1q(X[`'^e}._SR=G%{!U)?nt_!J}4tT2UHIJ&UJwݿOhY筊@n٘c֎#GA0 YR@+,.{+݄$A4G_~ T~=hJz>4z۽cAq|*у4<{$^Jۢn{R*zD iJռԐT&!+-ؿ4@#[" H ,OkMV?Q JPġÆzcZ-|Les Cst޿/9gP$3)lի{F:[?B-/CFk<J,@^h =WWadn>:FmQq+{#e ]ʶVKUuf.NaV]yNA0&9}ȑ>:Sz-Zx`Y[ 싰r} -(ŁInSi)Wh},~yzyr(f,p6šgDxkJh_@RFE>]IO;_͉C;0h;:~Ϻj& YivM՜moX^nX'iI]]<̊7))b&+!g!G?v;Y Do(#^\10'[FZCg<@x]*yZSԄpDZ͒`#!=LߣgQjϒvJFWSbx魃q j}TX߈i>Y-ڶSR]rv^7 kHWi*s -N/=3y8s,.ʆ0S0*b%G09mV q$2G!B;=BuULe'CV X8p=!">WT#Ĉ!`rnSq }GyѠqb,"N@Ц5(O;}"Q>9} -?TxMR.K7C֗Rq"2ǁc6 < tdY-J“!pT'D?!ExgTN9?~BFWWHY N31qwpcmϜSq=H$4,jؘ뚮[/4x`7R,YZ޼c/Yc+ʧWl ?^g"g2(Ǎ]bU| D4P2KzCXdQ"e-?ϢW&o$D9!ēfL4et=3Vj<7=i;*A/|-M+E0$HşYH;L{le~ <9z5"nynfAQRkT|w;4}VI8'@δ~MD5"QAȃ㩅R(ex (e8Y)+y89mFKcY|6&V_艵eYQ WM&Y 0_Jz lc/Ezc4&mMVⲋͮ\hb4_Aֹ7*nr_dm9rj?0Yi2\TWGA7 L;40k)-]^] BZ69? e4 ~+CcƅW._5+hB}=aVLUa ~˔~@> o-T g4"ٰ O@5˭̘.2S o'.%{"Yixћ'^|7$G{|-8e*7D!LANiWo['Tt6?AI'ۢ4Su" $cK_`{ɜjiADce ?@7 EeِK%7Rq;!e ~X|pQGx!V!);< 9nU݈$G *ȫo(Y "2[!!J[ 9zef.(eO ͟bqUجn"^3ERMs#yodf%6ːQo*W#wiQ4S, *rD囀 ۣY?'T = Cw ɻ :6}t:8&v>ju q-5)[Z |rX^/;!Mw+T.nOu ^Gz`DO%\k[j?AI/(ahF}CVi􀙷ޭ3;2{ (vU 2fk, YmLzyu$ែ6ȑn]5y+̼WV[K\kh$8,!뻔 3ԏP߭I3bqaqуjOTBVkv3yD,k&Je1=o/Ue=;[r%M8ofJTtf/E/A oYioJH/ /C7z=q`OjTS7z r#Ĩ^n Ftqh *i0p-iMe  Vj^܁ ^QOl&qp֬:.ʱcq?N3% " _\yNJf3gU۵%TI?rHcByCQ3U1JvSjۉ(%Gנ M, ~;rjM Ҹ177DmL8y!IJm!JHrgoE /BIܭr76$IO0E(PF> ]&yFl!fC>.*.1|rbV?Ŷwe-'!Ll]>Z֚,puڬI5lt"g9Tz.j7vߦ}ˡ4[-\0G:.>hȝFE\w/AV: i,__糴n1ZUpEHZ$r,6,xq=-Bְ+on|˫V&='6ޢz Yu<5$O P^Vr,pDjKRy< lkjj9<.d`B^%\,QbnCI5kBV;&W 5dRsu?44k=칪\]ɩs|U.=/U{%T<*-IeY]9t `,BӮn$xԬn,'kmϔY<)/npT,~yR6sp xJȄ<,~:卪"jnZƲ#G~U)K &G(Iz9HV匚[.d$ -$k.De5Dôv D.]/-S^KbSVڌ4@s5p?l\0!66Nx6*v)k7˅AsLȣl @qo7X I+[ j0=00a ^:vUODQ㶺VW*mq6;{L-%} ȄQI"۾W+pߒW_LFDŽv.Aq!+A]ߜAR%: d@6/6(d AұKgLc% ANڹ%ؤ gZHǣq&܆yq;aG*ܔVjo2W]fY"~焬!bYT-NL荸%gHH$C.+.CLY3nG\mVBiWV@7+ݯVn }F+i~T욘ՒcN4֢5FnfW`Xh.&N3/фneJ"K1K3fZ o_oXkW]fH3fU!FmΏ1j=6kI<ƖÇ17+UyjQr:/ VV(U)[1#.Yel9Zf6گc ׄL͒ VNH.dVw *.z!Fd]Tu?f`u?l4YO\CZ`^4qk,‹FMs| \aBҌb4UCu| #Z,M;4 ga M B&lDo2a{g)dvO@Tߩi1`T߭i7 &[< {^zB&ǭv=͋Fz8ݔtNK&9$JDVWmh9SƖ}׹JOqlc<4Vr#C7S,Ч|^E,YF\ "< R͒:v@J;TRWfbNr)ƎȭѬnAbCo7*FzNF%)Ҍ)dBb/p1sGoSƜ*҆ sRz77IoEnE!k8I<2iQ$ai{ExVHGÙ*Xނ\0rfYA J DK<Ѥ׭=Hޏd+QyT&zn܆ٴ5}kJTx\;LuRy=\P[۸ a)Ԇj=}xU6yl4# x?y`:ݟφR9iĮT13+ݠ$uؒn,hd6蒋@W 5mpUU B&lK[ (d79߮&+;M.,(0.d5L0rvWA"1G}=<#d CH=_S#6p9P k#<`DZCءΑPz@ةhÑ[b/cMK*k4"kK1Ƌ ,GBV˜17|Nju5*zOD◽ I1hdHhW>>vn}ó>%6bm[RqKOWn>-6d9&!.I"Oר, d ~m5*Y۽KE_' p㵡(.=Ȅ!jxȎ`fp,s:vjG [#`!6`1xsF!sX]n?gNXK,3%:+P`JO\I2g-1ܬE/ UBēgAI?.F,?)AҲv?-dBmk)Y/UȄ_ #e*ӈ¯SȄLVE)_~QȄPo$dJ C!zjZyޥ``ʒ<^]@t^nҮ[&c -yS<-|(ӠvF&]g!1S,|M;vI.9f:m';#uTWnpBppN:[iHG !kppM(W7> oW U 镭"9b ؉k@\Ω{6٩1!ۗ#c/$2kğ܆Ɉ_ 7dߑ7xcD.EhwZ8[6r&³gA _ V']0/ȿQ*B.A3Uq!!v)َc F&s,/̳@&p*@iu D~8{iR6I;"zJrq-J9M5)6I>EI!ہmLr &D4)TH;&e1C5-u4)1YfSUPIy`j\-}qS ?әYC oƍ["{K%?Y[~|d[nT ju?[euDWv&sÕ~&F̐bY͕)vB&5Bࠐ 5UFڬ/(^l_~}E-}y)&@U.kI6!4ӗҍcG_j݈Ɓ$2yr-J? [ (m/={ȮO%69z+R7ɮxq|ޫ(MJV-1'@f<Rl6F*X&ud$܂6W@J]6Bj܂6WB+#kc}j?m8KkgIv6ЃE*IM[F]2;w삑qلt6跢2;=Gqrp2eGPʅ (im'vtUzڲǷhWzH'rMMb1{ S:]>{{ bTj`DڹBTSB&s %2#S ?{$Vlzr` z\iB&|=.TXfj7lE0owe}3+7ߌ6Fh#'$aJ}S {(?T&ym-FzS?~SZ?rmsh^XHe`vN:xZa&{pJ&F:l¦ov&]aEQ6&^ӣ ut,e]7]ɲ&r*Nn1&bsG}~e*K4/}B&CcWyXԸ]6n|SPTl:tmZ˺hTChC7].P,?!D{`*u83^,ɑAi#rq9!kxeUsd;wKIדƯH;L4!NZP6/,4 cIˇR6H32d@/ YzhBBJ$dvTu?1 jEkyӳKqzs|]Tqw0vcܢ|ƸkUo1\t]`$Zn^̠ih3M& XhxȺWKފU%%b< .!FTPqjVijVeƯ^eOf]hh:yZg >%dˆ#^(é`Fz!ZO#[ ?p;M&m2G 勞0X=!꾭' ާ:t\CLѝzRqQ+ Y65my;BZMggkLAX7V(dEk WJN7fzjqM]+hL;:X}O .&G³J:ɞR]HK gdŘ-pO5&Fo#k+.i"SwP!B}J=3_2 Ǟqb"rvN/OVEzĶb;!wU!n3o$IAp=H׶Y7fCN Y !^!KweѤ#a6# L Y-T3D!AT!`Z &p'zM?#$1I3Glvpp8剩HpHu$Q2CH"/X:tyyڬ Om{Y7iw#饨ÍQ+HI6I2SilE=TfEz[n7^o5a&_XJxh:Z!{[JEҖ=ִE\͏vNx:H(cL/߭}X> }٧mf=q1JٔG5uڮzל!3.tVF7dU1CM8.dȩq"[F A iQg"GIzqgt7CnLjѣLj(n b[BOBhf3*Cg >Ȇ&~coe}+ߣ6F=j#'$a+:`:51Un[o2J}*2 JGr֩cITCIʐKu\P=vִE\~vN?v87xjgrOS".;O53\Y@-w]ϔ#?Sũȵx~MzMмkbūAźkQz~<.r @ 5C$ERȲ&՘pnZ-EZE@OBퟨѵ(=D!TN~!E,7T ϰz'X6_ȝS}f 4pr0$7x2i4.|PV4>"}e5fJ< Y4\ ?o6jpcc? AcF+FnkVDwǯ\fOfT2a7*&B&h7J:Q Pmao=<8HPG-T 嗍m=j! Ѝϳ7bIJ[1-z)8nƨ-Iy6ISjE MT\ujhh5VIvhCvɥjkM]ĹhLW3X?ލGMh:UGIa] Ѧw&rpde/UK >D$DžL̪H*52$a`?@Mcseyd}n5Gq%mqGY B-yqr7pG ;n̚l̛0YjOQ7cb&+dɅC:,vL}G=͏+IZ\|Zj<)C$RC=$BVA6f9ڟdCOH{/3';wXb?믒vo^:[\RCz;~U"9gG(8Y?0%<"3ܘX>ol]LVKvm&̀uFi#βxeTF""~ L-3no ᘐ [|Fiw*~Ge@64 hcFm^ m6VF_%Tj 3,HLV9U㥏'W4{T&34MuP-OY>o0gTX.݌f^)_u诮v^:\4E>Zo;DZ_a>Ty [a@^o?N$ї[9!['Age]vNzقxi&/ Ƭ[ ]I󶤦cǨ ޢ7R1B ʬADvL*svjΘgybHoſ $J6u'VlZ_BU?4ۄLj6ໄL2Uu?dl( ՞-*;2atVvp0 *u@Ȅlw'3aoF7_oZ3Gә .Ѣ} B&|=Z3֟Qah?ݼK~/zWOK/E,mZFNjIHM_ZjFT=W}pi6zU!`^~1Zw.n`%>S-wEQ[$y:e:$lQ^%hl27{^AH t0&wks'GF!I ~WMdKSf'kT=I/vXi-h>14RT~CşѤI> m1[ •Hiv`̙FSϦJ>Ͳ#4{Dsp@Ȅv ##!PorPN\elc&*B-KQGV8zڇm]ރZ{Su7G(J_({ _t'Dio]k'B)I6N Ne)~;(ݑ)Փ㱆?x6+SP+!'0'sfM ۸],W+~l;FY\jy\X GQ!ǎjBn߉f#AkPu?|Y m]JhcedmLGMf{Y.dWiZnQo14=: w/fB{.Q{hwBa~V`GuنL  0-u;KQLVδ@mY<0t&cj:ujhh5VXvpͼCvɥjkGN;aS{ݢ? sYr+d(z900f8<7YNM-ү}Ԇjs!rmVN8T,JQ!mIv'U=w8fYUB֐aKJGe`@O rn*0-dˆXH`*5OsM\Džim^l#v1P7mQ?@ctVX]*Cbk>x}诔v^:+¿Xom>PT{W<zWu ~l5U-7;~ejgGNUUۯ7ɯra9l"dg=B:.<i|!nLz z'\,1I"% Diy^7G*o_cJ^nb xXjM(VLQsT]5KsGڢ!Gpiw3#Gf٣CCفT2Cru*̅0\§`}oOl~ZuRy_,Uٝ*k륨c篍Q+vI6I`HKtID %Su<v Z[r5/`k( e7v+tnDQܸܝ$N4%3k#0noYb(+h`,oRahqʔ<97%\aS`zI͖WZGu/::tDo|_L\ |BZ q3|P:z<}ͣ72 |Y-%D!TnA!+?HJ)ɌH|!a!Gp"*~#>RE}<@'@Nvg|֭@?P~+_)^uxq1jG9& ۮ1CRLgFkMLmV۵d3VYjӼC(K-W;u<wD7_5yb>u5I3$E?Z|]N]vb:EDcL9qK21 f !$oy+ (ʙV$ZS-ӶÓJ!R~^ȄPq?M!{BV6IV_ȄPq #jc]mZSFNj߫I¶V)Щ O՛TT}+]h;o!;s";tpz92_)wWE=w āGS뭾[&$B?__ſ\G:1kST:?|'$lZ{$ ]p^4@t'~!krv(AyT;PWK:?<$dBS6bbJLC/pzLp3LbsMC0 -0-0 *+p 5ʜcQ]aŇLkUI(> 0ZG`0C]ʈfTv!j6Վ9cQ`c?jjCəG`Am˙G`:,';1Yl4I? P:mmnm lplcOl dB&=vy$z |BZcFQ] \^V3%J? +(djl<atnɑFS > Ye;3!&a Z76+8>^H؋^c袄EuBE 7*"wQb]ȊO4=ܥ{ 'dNJn*4-u-4k7)`'MڳFw1ﾓ+Vn0 1׻?i9nƽP-ZۡC%@Jgkg6,#=njU0 &`\,>m;>'G?Y)%ӢD-/11( f<;ZrD"^Ho6O OOhU|IIu3Oc7'AP{9&M@p\v}4xV}VјFToorM׽.kp !g0ΩȜu\ͩ;37aςjYX .^k&yiEB}Cl3eqi6?6=`^sD8jw e/p/X2^c~#Q/A0j7sg`ZU,7? 7gvrW/$㐾yS=CC h_dCLQWN8C0__j<~ <~I+Mbo`Fϓ+Y.a#{YV5ݰ=scTr|Dr͙<[ )[<>dN-~/rfɛ꽑ɳU$7Wk״jzӴ&.s2Z,l_D }6eVNep#ԷwсuIU.OuY( Vm+v55ϦEkgQFLBx5:O!MSr{wVu[ !gLE<+>gxqW6]L\hZ[y9VRKwR+cMw%| @|qwT5$ >帿h]5a'/_->76qd_9&e3INdWYf' CVsj[AfEy OA>Ձ|c=GCc=N[ [c8fYJjȫU5%Z-NkfŢ1ߥUn}5Vsh>[VX4IWMş >m{50ퟀGge:L4B>f܎35ʆKqhb#k;K/޺ l@|4~խ򚔽Vбvtէ/Q숉*wM7` rJdbXB'gLv4s,>ND>}z%BLU[qL+|Ǵُf6hb9\j5!<Vox^޵ f?rl:]n7QOF)h@* KBMމkq^.kOseQ1ہ ұs'OA~J^E#gO+pCVڍ7/%ÐmI6U p.D + "?ulLhUXh ͚;(C+=6Vq6]7+UhځXk!*;BQ싉8]3Wf9oEVhac}a\{jyohvv^|f; !UzKeM4i|4(= 579&饮(oeٵL*0? |+)f<R;xK%Usd;wSue^[潲GDpIb̘'-^;::z=~w;o[پd3l&3?rh6=:4t8Hmt:5RՕO~el&=c%| ~W =8l\XV{-BDl~Zu7􈏲iqQ6[~mgAjU^L)ȁp,J5VɞrL[6r_#reH]ICgHKt[?T[0ٯ9S ~KńZ,Q-wm:jϰQb6-5mfG`} ٥#G3! O0}[}7^D\eba:B"+yVKt$wqG$tB8y@FgO\O@>qgO Ld . @XO i/^yE}@QqCZCzvmv㢖ɑnݗ1th`. GavɤHev}r֞;c}Ϟ}g&ڋ\'CRD?jjLJi?{d jHuXhE+=.??ن?_MNw9EFoioOi0ɹoV$m`?F/ seriation/tests/0000755000176200001440000000000012636302712013413 5ustar liggesusersseriation/tests/testthat/0000755000176200001440000000000014201253522015245 5ustar liggesusersseriation/tests/testthat/test-map.R0000644000176200001440000000132414054175250017131 0ustar liggesuserslibrary(seriation) library(testthat) context("map") map <- seriation:::map v <- 0:10 expect_equal(map(v), seq(0, 1, length.out = length(v))) expect_equal(map(v, range = c(100,200)), seq(100, 200, length.out = length(v))) expect_equal(map(v, range = c(200,100)), seq(200, 100, length.out = length(v))) expect_error(map(v, from.range = c(200,100))) expect_error(map(v, from.range = c(0, 5, 10))) expect_equal(map(rep.int(1, 10)), rep(.5, 10)) m <- outer(0:10, 0:10, "+") expect_equal(map(m), outer(seq(0, 1, length.out = 11), seq(0, 1, length.out = 11), "+") / 2) context("map_int") map_int <- seriation:::map_int expect_identical(map_int(v, range = c(-100, 100)), as.integer(seq(-100, 100, length.out = length(v)))) seriation/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.R0000644000176200001440000000714014056446300022122 0ustar liggesuserslibrary(testthat) library(seriation) library(dendextend) ## Needed because it redefined all.equal for dendrograms 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 v <- structure(1:10, names = LETTERS[1:10]) expect_identical(permute(v, ser_permutation(1:10)), v[1:10]) expect_identical(permute(LETTERS[1:10], ser_permutation(1:10)), LETTERS[1:10]) expect_identical(permute(v, ser_permutation(10:1)), v[10:1]) expect_identical(permute(LETTERS[1:10], ser_permutation(10:1)), LETTERS[10:1]) expect_error(permute(v, ser_permutation(1:11))) ## matrix m <- matrix(runif(9), ncol=3, dimnames = list(1:3, LETTERS[1: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))) expect_identical(permute(m, ser_permutation(3:1, 3:1), margin = 1), m[3:1, ]) expect_identical(permute(m, ser_permutation(3:1, 3:1), margin = 2), m[ , 3:1]) expect_identical(permute(m, ser_permutation(3:1), margin = 1), m[3:1, ]) expect_identical(permute(m, ser_permutation(3:1), margin = 2), m[, 3:1]) ## data.frame df <- as.data.frame(m) expect_identical(permute(df, ser_permutation(1:3, 3:1)), df[,3:1]) expect_identical(permute(df, ser_permutation(3:1, 3:1)), df[3:1,3:1]) ## 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 ## FIXME: order.dendrogram in stats adds attribute value so I use ## check.attributes = FALSE, but dendrograms use attributes a lot so ## the check may be pointless dend <- as.dendrogram(hclust(d)) expect_equal(dend, permute(dend, get_order(dend))) #, # check.attributes = FALSE) expect_equal(rev(dend), permute(dend, rev(get_order(dend)))) #, # check.attributes = FALSE) # 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(as.hclust(rev(as.dendrogram(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.R0000644000176200001440000000404314067110610020002 0ustar liggesuserslibrary(seriation) library(testthat) 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, dimnames = list(1:4, LETTERS[1: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 }) # make sure they are all the right length expect_true(all(sapply(os, length) == nrow(x))) # TODO: check labels #get_order(os$Identity) ### 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 <- sapply(methods, function(m) { cat("Doing ", m, " ... ") tm <- system.time(o <- seriate(x, method = m)) cat("took ", tm[3],"s.\n") o }, simplify = FALSE) # check number and length of orders expect_true(all(sapply(os, length) == 2L)) expect_true(all(sapply(os, FUN = function(o2) sapply(o2, length)) == c(4L, 5L))) x_p <- permute(x, os[[1]]) expect_equal(x_p, x[get_order(os[[1]], 1), get_order(os[[1]], 2)]) # TODO: check labels #get_order(os$Identity, 1) #get_order(os$Identity, 2) #get_order(os$Reverse, 2) context("seriate with margin") methods <- list_seriation_methods(kind = "matrix") os <- sapply(methods, function(m) { cat("Doing ", m, " ... ") tm <- system.time(o <- seriate(x, method = m, margin = 2)) cat("took ", tm[3],"s.\n") o }, simplify = FALSE) expect_true(all(sapply(os, length) == 1L)) expect_true(all(sapply(os, FUN = function(o2) sapply(o2, length)) == c(5L))) x_p <- permute(x, os[[1]], margin = 2) expect_equal(x_p, x[, get_order(os[[1]])]) context("seriate data.frame") df <- as.data.frame(x) o <- seriate(df) permute(df, o) seriate(df, method = "PCA") o <- seriate(df, margin = 1) ## DEPRECATED: results in a message permute(df, o) permute(df, o, margin = 1) 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/0000755000176200001440000000000014201240333013026 5ustar liggesusersseriation/src/bea.f0000644000176200001440000002622513531271016013742 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.c0000644000176200001440000000532613531271016014152 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.f0000644000176200001440000003022313531271016014452 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.f0000644000176200001440000003001113531271016014443 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.f0000644000176200001440000001732713531271016014144 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/0000755000176200001440000000000014201240332014246 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.Rnw0000644000176200001440000024023314066706641016762 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 archaeology. \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 criteria 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 deviations 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", prop = FALSE) @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) @ \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 list of the available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= list_seriation_methods("dist") list_seriation_methods("matrix") @ To get detailed information on a seriation method use the following. <<>>= get_seriation_method("dist", name = "ARSA") @ 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", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_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. <<>>= list_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "New_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, row_labels = 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), row_labels = 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 @ In a newer version of the package this can be also done with the new heatmap seriation method for matrices. <<>>= get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_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, panel = panel.tiles) @ 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, panel = panel.tiles) @ 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))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, 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_iris, method = NA) @ <>= ## plot reordered matrix dissplot(d_iris, 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(x_iris, 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_iris, labels = l, main = "Dissimilarity plot - standard") @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) 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 = 3)) @ 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(ruspini, 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/0000755000176200001440000000000014132425662012455 5ustar liggesusersseriation/R/ggVAT.R0000644000176200001440000000247514073106761013560 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ggVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") ggpimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } ggiVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE, ...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") x <- path_dist(x) ggpimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri, ...) } seriation/R/seriate_SPIN.R0000644000176200001440000001432014054076463015071 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000001215714154546375016550 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## ser_permutation_vector represents a single permutation represented as an ## integer vector or a hclust object. ## Constructor ## x can be ## * an integer vector ## * a hclust or dendrogram object (leaf order) ## * NA represents the identity permutation ## * a ser_permutation (list) of length 1 ser_permutation_vector <- function(x, method = NULL) { if (inherits(x, "ser_permutation_vector")) return(x) if (inherits(x, "hclust") || inherits(x, "dendrogram")) { # nothing to do } else if (length(x) == 1 && is.na(x)) { x <- NA_integer_ attr(x, "method") <- "identity permutation" } else if (is.numeric(x)) { x <- as.integer(x) } else if (inherits(x, "ser_permutation") && length(x) == 1) { x <- x[[1]] } else { stop("x does not contain a supported permutation.") } if (!is.null(method)) attr(x, "method") <- method class(x) <- c("ser_permutation_vector", class(x)) .valid_permutation_vector(x) x } ## accessors ## returns the order of objects (index of first, second, etc. object) get_order <- function(x, ...) UseMethod("get_order") get_order.default <- function(x, ...) stop(gettextf("No permutation accessor implemented for class '%s'. ", class(x))) 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, ...) { if (.is_identity_permutation(x)) stop("Cannot get order vector from symbolic identity permutation (undefined length).") structure(as.integer(x), names = names(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 permutation 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 (inherits(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 ## an identity permutation is a single NA. .is_identity_permutation <- function(x) is.na(x[1]) ## calls stop if the vector is not valid .valid_permutation_vector <- function(x) { ## identity vector is always valid if (.is_identity_permutation(x)) return(invisible(TRUE)) ## valid permutations have a get_order function implemented 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 = ", ")) invisible(valid) } .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") invisible(TRUE) } seriation/R/ggdissplot.R0000644000176200001440000001066214154560033014760 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 ggdissplot <- function(x, labels = NULL, method = "Spectral", control = NULL, lower_tri = TRUE, upper_tri = "average", cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, ...) { check_installed("ggplot2") # 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'.") } x <- .arrange_dissimilarity_matrix(x, labels = labels, method = method, control = control) m <- .average_tri(x, lower_tri = lower_tri, upper_tri = upper_tri) k <- x$k dim <- attr(x$x_reordered, "Size") labels <- x$labels labels_unique <- unique(labels) # So we can add cluster labels later if (cluster_labels) colnames(m) <- seq(ncol(m)) g <- ggpimage(m, reverse_columns = reverse_columns, ...) # add cluster lines and labels if (!is.null(labels)) { cluster_width <- tabulate(labels)[labels_unique] cluster_cuts <- cumsum(cluster_width) cluster_center <- cluster_cuts - cluster_width / 2 clusters <- data.frame( center = cluster_center, cut = cluster_cuts, width = cluster_width, label = labels_unique ) ### NULLIFY for CRAN check center <- label <- cut <- NULL if (cluster_labels) { # Place cluster labels along diagonal # if (!flip) { # g <- g + ggplot2::geom_label(data = clusters, # ggplot2::aes( # x = center, # y = nrow(m) - center, # label = label # )) # } else{ # g <- g + ggplot2::geom_label(data = clusters, # ggplot2::aes( # x = ncol(m) - center, # y = nrow(m) - center, # label = label # )) # } # Place cluster labels on top as x-axis (needs the colnames set as a sequence) if (reverse_columns) { suppressMessages( g <- g + ggplot2::scale_x_discrete( breaks = ncol(m) - clusters$center, label = clusters$label, expand = c(0, 0), position = "top" ) + ggplot2::theme( axis.text.x = ggplot2::element_text( angle = 0, vjust = 0.5, hjust = .5 ) ) + ggplot2::labs(x = "Cluster") ) } else{ suppressMessages( g <- g + ggplot2::scale_x_discrete( breaks = clusters$center, label = clusters$label, expand = c(0, 0), position = "top" ) + ggplot2::theme( axis.text.x = ggplot2::element_text( angle = 0, vjust = 0.5, hjust = .5 ) ) + ggplot2::labs(x = "Cluster") ) } if (cluster_lines) { ## draw lines separating the clusters if (reverse_columns) { g <- g + ggplot2::geom_hline(data = clusters, ggplot2::aes(yintercept = nrow(m) - cut + .5)) + ggplot2::geom_vline(data = clusters, ggplot2::aes(xintercept = ncol(m) - cut + .5)) } else{ g <- g + ggplot2::geom_hline(data = clusters, ggplot2::aes(yintercept = nrow(m) - cut + .5)) + ggplot2::geom_vline(data = clusters, ggplot2::aes(xintercept = cut + .5)) } } } } # reverse color suppressMessages( g <- g + .gg_sequential_pal(dist = TRUE) ) g } seriation/R/pimage.R0000644000176200001440000001603614060002510014027 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ..., 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 = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ..., 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.") # set default values # 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(prop)) prop <- FALSE if (is.null(gp)) gp <- gpar() if (is.null(zlim)) zlim <- range(x, na.rm = TRUE) # reorder if (!is.null(order)) x <- permute(x, order) # mask triangles 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 # change x and y if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } # reverse order of columns if (reverse_columns) x <- x[, seq(ncol(x), 1)] # deal with row/col labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) # create layout for plot bottom_mar <- if (col_labels) max(stringWidth(colnames(x))) + unit(3, "lines") else unit(1, "lines") left_mar <- if (row_labels) max(stringWidth(rownames(x))) + unit(3, "lines") else unit(1, "lines") if (newpage) grid.newpage() if (key) { .grid_basic_layout_with_colorkey( main = main, left = left_mar, right = unit(0, "lines"), bottom = bottom_mar, gp = gp ) downViewport("colorkey") .grid_colorkey(zlim, col = col, horizontal = FALSE, lab = keylab) upViewport(1) } else .grid_basic_layout( main = main, left = left_mar, right = unit(0, "lines"), bottom = bottom_mar, gp = gp ) downViewport("plot") .grid_image( x, col = col, zlim = zlim, prop = prop ) #, gp=gp) ## axes and labs downViewport("image") if (col_labels) 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 (row_labels) 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 = "", zlim = NULL, key = TRUE, keylab = "", symkey = TRUE, upper_tri = FALSE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE, ..., 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) if (flip_axes) warning("flip_axes has no effect for distance matrices.") pimage.matrix( x, order = NULL, # already reordered main = main, xlab = xlab, ylab = ylab, col = col, zlim = zlim, key = key, keylab = keylab, symkey = symkey, upper_tri = upper_tri, lower_tri = lower_tri, row_labels = row_labels, col_labels = col_labels, prop = prop, flip_axes = FALSE, reverse_columns = reverse_columns, ..., newpage = newpage, pop = pop, gp = gp ) } seriation/R/bertinplot.R0000644000176200001440000001456014060002151014750 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. # TODO: let highlight be a threshold bertinplot <- function(x, order = NULL, panel.function = panel.bars, highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, ...) { if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") # add ... to options options <- list(...) options$panel.function <- panel.function options <- .get_parameters( options, list( panel.function = panel.bars, flip_axes = TRUE, frame = FALSE, spacing = 0.2, margins = c(5, 4, 8, 8), gp_labels = gpar(), gp_panels = gpar(), shading = NULL, shading_col = .sequential_pal(100), newpage = TRUE, pop = TRUE ) ) ## panel.blocks has no spacing! if (identical(options$panel.function, panel.blocks)) options$spacing <- 0 if (is.null(options$shading)) if (identical(options$panel.function, panel.blocks)) { options$shading <- TRUE } else { options$shading <- FALSE } ## order if (!is.null(order)) x <- permute(x, order) ## note: Bertin switched cols and rows for his display! # change x and y? if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } ## highlight if (is.logical(highlight) && highlight) highlight <- mean(x, na.rm = TRUE) ## clear page if (options$newpage) grid.newpage() ## create outer viewport xlim <- c(options$spacing, ncol(x) + 1 - options$spacing) pushViewport( plotViewport( margins = options$mar, layout = grid.layout(nrow(x), 1), xscale = xlim, yscale = c(0, nrow(x)), default.units = "native", name = "bertin" ) ) # shading and highlighting if (options$shading) col <- .map_color(x, options$shading_col) else col <- matrix(1, nrow = nrow(x), ncol = ncol(x)) if (highlight) col[x < highlight] <- NA # map to [0, 1] x <- map(x) for (variable in seq(nrow(x))) { value <- x[variable,] hl <- col[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 = seq(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( colnames(x), x = seq(ncol(x)), y = nrow(x) + spacing_corr, rot = 90, just = "left", default.units = "native", gp = options$gp_labels ) grid.text( rev(rownames(x)), x = 1 + spacing_corr / ncol(x) / 4, y = 0.5:(nrow(x) - 0.5) / nrow(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 = seq(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 empty squares grid.circle( x = seq(length(value)), y = unit(.5, "npc"), r = value / 2 * (1 - spacing), default.units = "native", gp = gpar(fill = hl, lty = lty) ) } panel.rectangles <- 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 = seq(length(value)), width = value * (1 - spacing), height = value * (1 - spacing), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl, lty = lty) ) } panel.squares <- panel.rectangles panel.tiles <- function(value, spacing, hl) { grid.rect( x = seq(length(value)), width = 1, height = unit(1, "npc"), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl) ) } panel.blocks <- panel.tiles ### hl is ignored panel.lines <- function(value, spacing, hl) { grid.lines( x = seq(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, col = "red") { 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 = col, lwd = 2) ) } seriation/R/criterion.matrix.R0000644000176200001440000000750114054756415016112 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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)) { warning("Bond energy (ME) is only defined for nonnegative matrices. Returning NA.") return(NA_real_) } 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.R0000644000176200001440000000542014054075565014762 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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) utils::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/seriate.matrix.R0000644000176200001440000000411614067105604015537 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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", ...) seriate_matrix_identity <- function(x, control) { control <- .get_parameters(control, NULL) lapply(dim(x), seq) } seriate_matrix_reverse <- function(x, control) { control <- .get_parameters(control, NULL) lapply(dim(x), seq, to = 1) } seriate_matrix_random <- function(x, control) { control <- .get_parameters(control, NULL) lapply( dim(x), FUN = function(l) sample(seq(l)) ) } set_seriation_method("matrix", "Identity", seriate_matrix_identity, "Identity permutation") set_seriation_method("matrix", "Reverse", seriate_matrix_reverse, "Reversed 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", "Reverse", seriate_matrix_reverse, "Reversed identity permutation") set_seriation_method("array", "Random", seriate_matrix_random, "Random permutation") seriation/R/dissimilartiy.R0000644000176200001440000001731614054075737015505 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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, inherits, "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, inherits, "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.R0000644000176200001440000000376714054076540014420 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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/register_optics.R0000644000176200001440000000253614132425700016004 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## register seriation based on OPTICS register_optics <- function() { check_installed("dbscan") .contr <- list( eps = NULL, minPts = 5 ) optics_order <- function(x, control) { control <- .get_parameters(control, .contr) dbscan::optics(x, eps = control$eps, minPts = control$minPts)$order } set_seriation_method( "dist", "optics", optics_order, "Use ordering points to identify the clustering structure (OPTICS) to create an order", .contr ) } seriation/R/map.R0000644000176200001440000000450614057266045013366 0ustar liggesusers####################################################################### # Code to map between ranges for continuous variables # Copyright (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) { ## deal with infinite values infs <- is.infinite(x) if (any(infs)) { warning("x contains infinite values. +Inf will be mapped to be mapped to largest value + range and -Inf to smallest value - range.") min_max <- range(x[!infs], na.rm = TRUE) pos_inf_val <- min_max[2] + (min_max[2] - min_max[1]) neg_inf_val <- min_max[1] - (min_max[2] - min_max[1]) x[infs] <- ifelse(sign(x[infs] > 0), pos_inf_val, neg_inf_val) } ## set from range if (any(is.na(from.range))) from.range <- range(x, na.rm = TRUE) if (length(from.range) != 2L || from.range[1] > from.range[2]) stop('from.range needs to contain 2 numbers (upper <= lower bound).') from.range_width <- from.range[2] - from.range[1] if (length(range) != 2L) stop('range needs to contain 2 numbers (upper and lower bound).') range_width <- range[2] - range[1] ## if all values are the same and no from.range is given, then return the average range if (from.range_width == 0) { x[] <- mean(range) return(x) } ## map to [0,1] x <- (x - from.range[1]) / from.range_width ## map from [0,1] to [range] x <- x * range_width + range[1] x } map_int <- function(x, range = c(1L, 100L), from.range = NA) { if (length(range) == 1L) range <- c(1L, range) as.integer(map(x, c(range[1], range[2]), from.range)) } seriation/R/register_tsne.R0000644000176200001440000000337514132361671015464 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## register seriation based on t-SNE register_tsne <- function() { check_installed("Rtsne") .contr <- list( max_iter = 1000, theta = 0, perplexity = 30, eta = 200, mds = TRUE ) tsne_order <- function(x, control) { control <- .get_parameters(control, .contr) # start with MDS if(control$mds) Y_init <- cmdscale(x, k = 1) else Y_init <- NULL # calculate the maximal value for perplexity perplexity <- min(control$perplexity, floor(attr(x, "Size") / 3) - 1) embedding <- Rtsne::Rtsne(x, dims = 1, is_distance = TRUE, max_iter = control$max_iter, theta = control$theta, eta = control$eta, perplexity = perplexity, Y_init = Y_init) order(embedding$Y) } set_seriation_method( "dist", "tsne", tsne_order, "Use 1D t-distributed stochastic neighbor embedding (t-SNE) to one dimension to create an order", .contr ) } seriation/R/gghmap.R0000644000176200001440000000271114066703715014050 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. gghmap <- function(x, distfun = dist, method = "OLO", control = NULL, scale = c("none", "row", "column"), prop = FALSE, ...) { scale <- match.arg(scale) if (inherits(x, "dist")) { # scale and distFun are ignored! o <- seriate(x, method = method, control = control) } else { x <- as.matrix(x) contr <- list( dist_fun = distfun, seriation_method = method, seriation_control = control, scale = scale ) o <- seriate( x, method = "heatmap", control = contr ) } ggpimage(x, o, prop = prop, ...) } seriation/R/data.R0000644000176200001440000000453414054075723013521 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000001444514067105547014275 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. # helper ndim <- function(x) length(dim(x)) # 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.data.frame <- 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.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!") # modeled after rotate in dendextend. Copied here to reduce the heavy dependency count of dendextend. # x <- dendextend::rotate(x, order = match(get_order(order), get_order(x))) rot <- function (x, order, ...) { if (missing(order)) { warning("'order' parameter is missing, returning the tree as it was.") return(x) } labels_x <- labels(x) order_x <- order.dendrogram(x) number_of_leaves <- length(order_x) if (!is.numeric(order)) { order <- as.character(order) if (length(intersect(order, labels_x)) != number_of_leaves) { stop( "'order' is neither numeric nor a vector with ALL of the labels (in the order you want them to be)" ) } order <- match(order, labels_x) } weights <- seq_len(number_of_leaves) weights_for_order <- numeric(number_of_leaves) weights_for_order[order_x[order]] <- weights reorder(x, weights_for_order, mean, ...) } x <- rot(x, order = match(get_order(order), get_order(x))) if (any(get_order(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 (ndim(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, margin = NULL, ...) { .nodots(...) if (!inherits(order, "ser_permutation")) order <- ser_permutation(order) # DEPRECATED: Compatibility with old permutation for data.frame if (is.data.frame(x) && is.null(margin) && length(order) == 1) { message("permute for data.frames with a single seriation order is now deprecated. Specify the margin as follows: 'permute(x, order, margin = 1)'") margin <- 1 } # create complete order object for margin if (!is.null(margin)) { if (length(margin) != 1 || !(margin %in% seq(ndim(x)))) stop("margin needs to be a single integer index indicating the dimension to permute.") margin <- as.integer(margin) if (length(order) != 1 && length(order) != ndim(x)) stop("order needs to contain either orders for all dimensions or just a single order for the selected margin.") if (length(order) == 1) { length(order) <- ndim(x) order[[margin]] <- order[[1]] } # set all other dimensions to identity. for (i in seq(ndim(x))) { if (i != margin) order[[i]] <- ser_permutation_vector(NA) } } # expand 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_heatmap.R0000644000176200001440000000521114154500546015731 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 distances for rows and columns, perform hclust and reorder. .heatmap_contr <- list( dist_fun = list(row = dist, col = dist), seriation_method = list(row = "OLO", col = "OLO"), seriation_control = list(row = NULL, col = NULL), scale = "none", verbose = FALSE ) seriate_matrix_heatmap <- function(x, control = NULL) { control <- .get_parameters(control, .heatmap_contr) if (length(control$dist_fun) == 1L) control$dist_fun <- list(row = control$dist_fun, col = control$dist_fun) if (length(control$seriation_method) == 1L) control$seriation_method <- list(row = control$seriation_method, col = control$seriation_method) if (length(control$seriation_control) == 1L) control$seriation_control <- list(row = control$seriation_control, col = control$seriation_control) if (!is.null(control$scale)) { if (control$scale == "row") x <- t(scale(t(x))) if (control$scale == "col") x <- scale(x) } d <- control$dist_fun$row(x) o_row <- seriate(d, method = control$seriation_method$row, control = control$seriation_control$row) d <- control$dist_fun$col(t(x)) o_col <- seriate(d, method = control$seriation_method$col, control = control$seriation_control$col) #names(row) <- rownames(x)[get_order(o_row)] #names(col) <- colnames(x)[get_order(o_col)] list(row = o_row[[1]], col = o_col[[1]]) } set_seriation_method( "matrix", "Heatmap", seriate_matrix_heatmap, "Calculate distances for row and column vectors, and seriate. If only a single distance function or seriation method is specified, then it is used for rows and columns. The default seriation method is optimal leaf ordering (OLO) which perform hierarchical clustering and reorder the dentrograms.", .heatmap_contr ) seriation/R/seriate_VAT.R0000644000176200001440000000366414054076463014763 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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/dissplot.R0000644000176200001440000004740214060002706014436 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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, lower_tri = TRUE, upper_tri = "average", cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = FALSE, options = NULL, ...) { ## add ... to options options <- c(options, list(...)) options$cluster_labels <- cluster_labels options$cluster_lines <- cluster_lines options$reverse_columns <- reverse_columns ## 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'.") } a <- .arrange_dissimilarity_matrix(x, labels = labels, method = method, control = control) if (is.null(options$plot) || options$plot) plot(a, lower_tri, upper_tri, options) invisible(a) } ## 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 structure( 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 = "reordered_cluster_dissimilarity_matrix" ) } ## create panels with avg. dissimilarity ## a is an arrangement .average_tri <- function(a, lower_tri = "average", upper_tri = TRUE) { if (!inherits(a, "reordered_cluster_dissimilarity_matrix")) stop("a needs to be a reordered_cluster_dissimilarity_matrix") upper_avg <- !is.na(pmatch(tolower(upper_tri), "average")) lower_avg <- !is.na(pmatch(tolower(lower_tri), "average")) k <- a$k labels <- a$labels labels_unique <- a$cluster_order cluster_dissimilarities <- a$cluster_dissimilarities m <- as.matrix(a$x_reordered) ## blank out if FALSE or NA if (is.na(upper_tri) || (is.logical(upper_tri) && !upper_tri)) { m[upper.tri(m)] <- NA upper_tri <- FALSE } if (is.na(lower_tri) || (is.logical(lower_tri) && !lower_tri)) { m[lower.tri(m)] <- NA lower_tri <- FALSE } ## do off-diagonal averages by cluster if (!is.null(cluster_dissimilarities) && !is.null(labels) && (upper_avg || lower_avg)) { for (i in seq(2, k)) { for (j in seq(i - 1)) { ## check empty clusters if (is.na(labels_unique[i])) next if (is.na(labels_unique[j])) next ## lower panels if (lower_avg) { m[labels == labels_unique[i], labels == labels_unique[j]] <- cluster_dissimilarities[i, j] } ## upper panels if (upper_avg) { m[labels == labels_unique[j], labels == labels_unique[i]] <- cluster_dissimilarities[i, j] } } } ## do diagonal for (i in seq(1, k)) { block <- m[labels == labels_unique[i], labels == labels_unique[i]] if (upper_avg) { block[upper.tri(block, diag = TRUE)] <- cluster_dissimilarities[i, i] m[labels == labels_unique[i], labels == labels_unique[i]] <- block } if (lower_avg) { block[lower.tri(block, diag = TRUE)] <- cluster_dissimilarities[i, i] m[labels == labels_unique[i], labels == labels_unique[i]] <- block } } } m } ## plot for reordered_cluster_dissimilarity_matrix plot.reordered_cluster_dissimilarity_matrix <- function(x, lower_tri = TRUE, upper_tri = "average", options = NULL, ...) { ## add ... to options options <- c(options, list(...)) k <- x$k dim <- attr(x$x_reordered, "Size") labels <- x$labels #labels_unique <- unique(labels) labels_unique <- x$cluster_order m <- .average_tri(x, lower_tri = lower_tri, upper_tri = upper_tri) ## default plot options options <- .get_parameters( options, list( cluster_labels = TRUE, cluster_lines = TRUE, reverse_columns = 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 if (options$reverse_columns) 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) cluster_center_y <- cluster_cuts_y - cluster_width_y / 2 if (options$reverse_columns) { labels_unique_x <- rev(labels_unique) cluster_width_x <- (tabulate(labels)[labels_unique_x]) 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$cluster_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.R0000644000176200001440000000300014054076463014757 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000772014054076463014631 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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, paste0( "Minimize a specified seriation measure (criterion) using simulated annealing.\n", "Control parameters:\n", " - criterion to optimize\n", " - init (initial order; use \"Random\" for no warm start\n", " - localsearch (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)\n", " - cool (cooling rate)\n", " - tmin (minimum temperature)\n", " - swap_to_inversion (proportion of swaps to inversions)\n", " - nlocal (number of objects times nlocal is the number of search tries per temperature\n" ), .sa_contr ) seriation/R/seriate.array.R0000644000176200001440000000407314067105571015356 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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(ndim(x)), datatype = "array", ...) { ## add ... to control control <- c(control, list(...)) 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) for (i in seq(ndim(x))) if (!is.null(dimnames(x)[[i]]) && is.integer(order[[i]])) names(order[[i]]) <- dimnames(x)[[i]] 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", ...) ## 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.R0000644000176200001440000000510414054076463016135 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000461214056442744015157 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## constructor ser_permutation <- function(x, ...) { x <- c(list(x), list(...)) x <- lapply( x, FUN = function(obj) { if (inherits(obj, "ser_permutation")) return(obj) if (inherits(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 don't 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/ggbertinplot.R0000644000176200001440000001257114154560516015310 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ggbertinplot <- function(x, order = NULL, geom = "bar", highlight = TRUE, row_labels = TRUE, col_labels = TRUE, flip_axes = TRUE, prop = FALSE, ...) { check_installed("ggplot2") if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") geom <- match.arg(tolower(geom), choices = c("tile", "rectangle", "circle", "line", "bar", "none")) # reorder if (!is.null(order)) x <- permute(x, order) # change x and y? if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } if (is.logical(highlight) && highlight) highlight <- mean(x, na.rm = TRUE) g <- .ggpimage_empty( x, row_labels = row_labels, col_labels = col_labels, prop = prop, expand = geom != "raster" ) if (col_labels) breaksCol <- ggplot2::waiver() else breaksCol <- NULL if (row_labels) breaksRow <- ggplot2::waiver() else breaksRow <- NULL # put col labels on top (message about replacing scale for x) suppressMessages( g <- g + ggplot2::scale_x_discrete( breaks = breaksRow, position = "top", expand = if (geom != "raster") ggplot2::waiver() else c(0, 0) ) + ggplot2::scale_y_discrete( breaks = breaksCol, position = "right", expand = if (geom != "raster") ggplot2::waiver() else c(0, 0) ) + ggplot2::theme(axis.text.x = ggplot2::element_text(hjust = 0, vjust = .5)) + ggplot2::theme(legend.position = "bottom") ) # add geom # raster does not use highlight if (geom == "tile") g <- g + ggplot2::geom_raster(ggplot2::aes(fill = x)) if (geom == "circle") if (highlight) { suppressMessages( g <- g + ggplot2::geom_point( ggplot2::aes(size = x, fill = x > highlight), color = "black", pch = 21 ) + .gg_logical_pal() + ggplot2::guides(fill = "none", size = "none") ) } else{ g <- g + ggplot2::geom_point(ggplot2::aes(size = x)) } if (geom == "rectangle") if (highlight) { suppressMessages( g <- g + ggplot2::geom_tile( ggplot2::aes( x = col, y = row, height = x / max(x, na.rm = TRUE) * .8, width = x / max(x, na.rm = TRUE) * .8, fill = x > highlight ), color = "black" ) + .gg_logical_pal() + ggplot2::guides(fill = "none") ) } else{ g <- g + ggplot2::geom_tile(ggplot2::aes(height = x / max(x) * .9), width = .8) } # TODO: do not display facet labels when row_labels == FALSE # no highlight for line if (geom == "line") g <- g + ggplot2::geom_line(ggplot2::aes(x = col, y = x, group = row)) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder(row, rev(as.integer( row ))))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) if (geom == "bar") if (highlight) { suppressMessages( g <- g + ggplot2::geom_bar( ggplot2::aes( x = col, y = x, group = row, fill = x > highlight ), stat = "identity", color = "black", width = .8 ) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder( row, rev(as.integer(row)) ))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) + .gg_logical_pal() + ggplot2::guides(fill = "none") ) } else{ g <- g + ggplot2::geom_bar(ggplot2::aes(x = col, y = x, group = row), stat = "identity", width = .8) + # Note: facets display the lowest level first so we need to reverse them ggplot2::facet_grid(rows = ggplot2::vars(stats::reorder(row, rev( as.integer(row) )))) + ggplot2::theme( strip.text.y.right = ggplot2::element_text(angle = 0, color = "black"), strip.background = ggplot2::element_blank() ) } g } seriation/R/criterion.dist.R0000644000176200001440000002023014054075631015535 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000720414054076463014744 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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<=b n) 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/seriate.data.frame.R0000644000176200001440000000212514067114551016234 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 data.frame seriate.data.frame <- function(x, method = "Heatmap", control = NULL, margin = c(1, 2), ...) .seriate_array_helper(as.matrix(x), method, control, margin, datatype = "matrix", ...) seriation/R/hmap.R0000644000176200001440000002332614066702302013526 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ### TODO: make sure dists are seriated and shown with the diagonal top-left to bottom-right. hmap <- function(x, distfun = dist, method = "OLO", control = NULL, scale = c("none", "row", "column"), showDend = TRUE, col = NULL, row_labels = NULL, col_labels = NULL, ...) { scale <- match.arg(scale) if (is.null(col)) { if (any(x < 0, na.rm = TRUE)) col <- .diverge_pal() else col <- .sequential_pal() } # dist or matrix? if (inherits(x, "dist")) { dist_row <- dist_col <- x o_col <- o_row <- seriate(x, method = method, control = control)[[1]] x <- as.matrix(x) # dist uses reversed colors! col <- rev(col) } else { if (!is.matrix(x)) x <- as.matrix(x) if (!is.null(scale)) { if (scale == "row") x <- t(scale(t(x))) if (scale == "col") x <- scale(x) } dist_row <- distfun(x) o_row <- seriate(dist_row, method = method, control = control)[[1]] #o_row <- ser_align(list(ser_permutation_vector(order(rowMeans(x, na.rm = TRUE), decreasing = TRUE)), o_row))[[2]] dist_col <- distfun(t(x)) o_col <- seriate(dist_col, method = method, control = control)[[1]] #o_col <- ser_align(list(ser_permutation_vector(order(colMeans(x, na.rm = TRUE), decreasing = FALSE)), o_col))[[2]] } # is hierarchical? then let's do a heatmap from stats if (inherits(o_col, "hclust") && showDend) { # heatmap by default scales rows: we don't want that! # options are ignored for now: we use ... stats::heatmap( x, Rowv = as.dendrogram(o_row), Colv = as.dendrogram(o_col), scale = "none", col = col, labRow = row_labels, labCol = col_labels, ... ) } else { ### we plot seriated distance matrices .hmap_dist(x, method, dist_row, dist_col, o_row, o_col, col = col, row_labels = row_labels, col_labels = col_labels, ...) } ## return permutation indices return(invisible(list( rowInd = o_row, colInd = o_col, seriation_method = method ))) } ## grid-based 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, keylab = "", row_labels = NULL, col_labels = NULL, 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, zlim = options$zlim, row_labels = options$row_labels, col_labels = options$col_labels, 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) # deal with row/col labels row_labels <- options$row_labels col_labels <- options$col_labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) ## Note: we need a list to store units! if (is.null(options$margins)) { options$margins <- list(unit(1, "lines"), unit(1, "lines")) if (col_labels) options$margins[[1]] <- max(stringWidth(colnames(x))) + unit(2, "lines") if (row_labels) options$margins[[2]] <- max(stringWidth(rownames(x))) + unit(2, "lines") all_names <- c("", if (col_labels) colnames(x), if (row_labels) 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 (col_labels) grid.text( colnames(x), y = unit(-1, "lines"), x = unit(1:ncol(x), "native"), rot = 90, just = "right" ) # , gp=options$gp) if (row_labels) 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$keylab, gp = options$gp ) popViewport(2) } popViewport(2) } seriation/R/hclust_greedy.R0000644000176200001440000000242314054075771015447 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000432314054076540015200 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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/colors.R0000644000176200001440000000655614154561463014121 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. # library(colorspace) .map_color_01 <- function(x, col) { x[] <- col[map_int(x, length(col), from.range = c(0, 1))] x } # translate all data to a color .map_color <- function(x, col, from.range = NA) { x[] <- col[map_int(x, length(col), from.range)] x } bluered <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(colorspace::diverging_hcl(n, palette = "Blue-Red", power = power, ...), bias = bias)(n) #hclplot(bluered(10)) #plot(1:20, col = bluered(20), pch = 19, cex = 4) greenred <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::diverging_hcl(n, palette = "Red-Green", power = power, ...) ), bias = bias)(n) #hclplot(greenred(10)) #plot(1:20, col = greenred(20), pch = 19, cex = 4) reds <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Reds", power = power, ...) ), bias = bias)(n) #hclplot(reds(10)) #plot(1:20, col = reds(20), pch = 19, cex = 4) blues <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Blues 2", power = power, ...) ), bias = bias)(n) #hclplot(blues(10)) #plot(1:20, col = blues(20), pch = 19, cex = 4) greens <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Greens", power = power, ...) ), bias = bias)(n) #hclplot(greens(10)) #plot(1:20, col = greens(20), pch = 19, cex = 4) greys <- grays <- function(n = 100, bias = 1, power = 1, ...) grDevices::colorRampPalette(rev( colorspace::sequential_hcl(n, palette = "Grays", power = power, ...) ), bias = bias)(n) #hclplot(greys(10)) #plot(1:20, col = greys(20), pch = 19, cex = 4) ## define default colors #.sequential_pal <- grays .sequential_pal <- blues .diverge_pal <- bluered ## define default ggplot2 colors .gg_logical_pal <- function() ggplot2::scale_fill_manual(values = c("white", "black"), na.value = "white") .gg_sequential_pal <- function(dist = FALSE) { if (dist) ggplot2::scale_fill_gradient(low = scales::muted("blue"), high = "white", na.value = "white") else ggplot2::scale_fill_gradient(low = "white", high = scales::muted("blue"), na.value = "white") } .gg_diverge_pal <- function() ggplot2::scale_fill_gradient2( low = scales::muted("red"), mid = "white", high = scales::muted("blue"), na.value = "white", midpoint = 0 ) seriation/R/seriate_MDS.R0000644000176200001440000000505514054076360014744 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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/ggpimage.R0000644000176200001440000001372514154557745014404 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ggpimage <- function(x, order = NULL, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE) UseMethod("ggpimage") ### Note for matrix large values are dark, for dist large values are light! ggpimage.matrix <- function(x, order = NULL, upper_tri = TRUE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE) { check_installed("ggplot2") 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.") # reorder if (!is.null(order)) x <- permute(x, order) # mask triangles 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 # reverse order of columns if (reverse_columns) x <- x[, seq(ncol(x), 1)] # change x and y? if (flip_axes) { x <- t(x) tmp <- row_labels row_labels <- col_labels col_labels <- tmp } # plot g <- .ggpimage_empty( x, row_labels = row_labels, col_labels = col_labels, prop = prop, expand = FALSE ) g <- g + ggplot2::geom_raster(ggplot2::aes(fill = x)) g } ### Note for matrix large values are dark, for dist large values are light! .ggpimage_empty <- function(x, row_labels = NULL, col_labels = NULL, prop = TRUE, expand = TRUE) { check_installed("ggplot2") 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.") # deal with row/col labels if (!is.null(row_labels) && !is.logical(row_labels)) { if (length(row_labels) != nrow(x)) stop("Length of row_labels does not match the number of rows of x.") rownames(x) <- row_labels row_labels <- TRUE } if (!is.null(col_labels) && !is.logical(col_labels)) { if (length(col_labels) != ncol(x)) stop("Length of col_labels does not match the number of columns of x.") colnames(x) <- col_labels col_labels <- TRUE } if (is.null(row_labels)) if (!is.null(rownames(x)) && nrow(x) < 25) { row_labels <- TRUE } else{ row_labels <- FALSE } if (is.null(col_labels)) if (!is.null(colnames(x)) && ncol(x) < 25) { col_labels <- TRUE } else{ col_labels <- FALSE } if (is.null(rownames(x))) rownames(x) <- seq(nrow(x)) if (is.null(colnames(x))) colnames(x) <- seq(ncol(x)) # convert to data.frame with row, col and x x_df <- data.frame( row = factor(rep(seq(nrow( x )), times = ncol(x)), levels = seq(nrow(x), 1)), col = factor(rep(seq(ncol( x )), each = nrow(x)), levels = seq(ncol(x))), x = as.vector(x) ) if (!is.null(rownames(x))) levels(x_df[["row"]]) <- rev(rownames(x)) if (!is.null(colnames(x))) levels(x_df[["col"]]) <- colnames(x) # plot g <- ggplot2::ggplot(x_df, ggplot2::aes(y = row, x = col)) # axes (row and col labels) if (expand) expand <- ggplot2::waiver() else expand <- c(0, 0) if (col_labels) breaksCol <- ggplot2::waiver() else breaksCol <- NULL if (row_labels) breaksRow <- ggplot2::waiver() else breaksRow <- NULL g <- g + ggplot2::scale_x_discrete(breaks = breaksCol, expand = expand) + ggplot2::scale_y_discrete(breaks = breaksRow, expand = expand) # no axis or legend labels g <- g + ggplot2::labs(x = NULL, y = NULL, fill = NULL) g <- g + ggplot2::theme(axis.text.x = ggplot2::element_text( angle = 90, hjust = 1, vjust = .5 )) if (prop) g <- g + ggplot2::theme(aspect.ratio = nrow(x) / ncol(x)) # colors scales if (is.logical(x)) { g <- g + .gg_logical_pal() # colors for diverging } else if (any(x < 0, na.rm = TRUE) && any(x > 0, na.rm = TRUE)) { g <- g + .gg_diverge_pal() } else { g <- g + .gg_sequential_pal() } g } ggpimage.default <- ggpimage.matrix ## small values are dark ggpimage.dist <- function(x, order = NULL, upper_tri = FALSE, lower_tri = TRUE, row_labels = NULL, col_labels = NULL, prop = TRUE, flip_axes = FALSE, reverse_columns = FALSE) { check_installed("ggplot2") # reorder specific for dist (we have only a single permutation) if (!is.null(order)) x <- permute(x, order) if (flip_axes) warning("flipping axes has no effect for distance matrices.") g <- ggpimage.matrix( as.matrix(x), order = NULL, upper_tri, lower_tri, row_labels, col_labels, prop = prop, flip_axes = FALSE, reverse_columns = reverse_columns ) # reverse color for dist suppressMessages(g <- g + .gg_sequential_pal(dist = TRUE) ) g } seriation/R/VAT.R0000644000176200001440000000406414073106761013236 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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, upper_tri = TRUE, lower_tri = TRUE,...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") pimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri,...) } iVAT <- function(x, upper_tri = TRUE, lower_tri = TRUE,...) { if (!inherits(x, "dist")) stop("x needs to be of class 'dist'!") x <- path_dist(x) pimage(x, seriate(x, "VAT"), upper_tri = upper_tri, lower_tri = lower_tri,...) } seriation/R/reorder.hclust.R0000644000176200001440000000373514054076256015557 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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/check_installed.R0000644000176200001440000000263214054022221015702 0ustar liggesusers## This is a modified version from package rlang that only uses base R functionality. ## action can be "install" (from CRAN), "stop" (with message), "check" (returns TRUE/FALSE) ## manual can be either TRUE or a string with installation instructions. check_installed <- function (pkg, action = "install", message = NULL) { action <- match.arg(action, choices = c("install", "stop", "check")) if (!is.character(pkg)) stop("`pkg` must be a package name or a vector of package names.") needs_install <- sapply(pkg, function(x) ! requireNamespace(x, quietly = TRUE)) if (action == "check") return(!any(needs_install)) if (any(needs_install)) { if (!interactive()) stop(info) missing_pkgs <- pkg[needs_install] missing_pkgs_enum <- paste(missing_pkgs, collapse = ", ") info <- paste("The", missing_pkgs_enum, "package(s) is/are required.") if (action == "install") { question <- "Would you like to install the package(s)?" cat(info, "\n", question, sep = '') if (utils::menu(c("Yes", "No")) != 1) { invokeRestart("abort") } utils::install.packages(missing_pkgs) } else { ### this is stop cat(info, "\n", message, sep = '') invokeRestart("abort") } } invisible(TRUE) } seriation/R/criterion.array.R0000644000176200001440000000361014054075620015711 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000415314054076463014713 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000452514054075511013332 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000552414054076330014706 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000000603614132422523014771 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## register GA for seriation # 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() { check_installed("GA") .ga_contr <- list( criterion = "BAR", suggestions = c("TSP", "QAP_LS", "Spectral"), selection = GA::gaperm_nlrSelection, crossover = GA::gaperm_oxCrossover, mutation = 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.R0000644000176200001440000001145014055511464014607 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 = "complete") .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/parameters.R0000644000176200001440000000411714054076040014741 0ustar liggesusers####################################################################### # Code to check parameter/control objects # Copyright (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/seriate.R0000644000176200001440000000574214154477140014246 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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) { if (missing(kind)) method <- registry_seriate$get_entry(name = name) else method <- registry_seriate$get_entry(kind = kind, name = name) if (is.null(method)) stop( "Unknown seriation method ", name, " for data type ", kind, ". 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) { if (missing(kind)) { kinds <- unique(sort(as.vector( sapply(registry_seriate$get_entries(), "[[", "kind") ))) sapply( kinds, FUN = function(k) list_seriation_methods(k) ) } else{ sort(as.vector(sapply( registry_seriate$get_entries(kind = kind), "[[", "name" ))) } } ### deprecated show_seriation_methods <- function(kind) { warning("Function is deprecated use: get_seriation_method() instead!") if (missing(kind)) m <- registry_seriate$get_entries() else m <- registry_seriate$get_entries(kind = kind) m[sort(names(m))] } seriation/R/register_umap.R0000644000176200001440000000270014132371056015442 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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. ## register seriation based on umap register_umap <- function() { check_installed("umap") .contr <- unclass(umap::umap.defaults) .contr$n_components <- 1 .contr$input <- "dist" umap_order <- function(x, control) { control <- .get_parameters(control, .contr) class(control) <- class(umap::umap.defaults) embedding <- umap::umap(as.matrix(x), config = control) order(embedding$layout) } set_seriation_method( "dist", "umap", umap_order, "Use 1D Uniform manifold approximation and projection (UMAP) embedding to create an order", .contr ) } seriation/R/seriate_PCA.R0000644000176200001440000000630214055251565014723 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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 principal 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.R0000644000176200001440000000561614055273671014613 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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)) { kinds <- unique(sort(as.vector( sapply(registry_criterion$get_entries(), "[[", "kind") ))) sapply( kinds, FUN = function(k) list_criterion_methods(k) ) } else{ sort(as.vector(sapply( registry_criterion$get_entries(kind = kind), "[[", "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/robinson.R0000644000176200001440000000320614054076270014432 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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.R0000644000176200001440000001031514054076310017357 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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", 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/grid_helpers.R0000644000176200001440000001537514057164163015264 0ustar liggesusers####################################################################### # Basic Grid helpers # Copyright (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 ## requires map.R .grid_basic_layout <- function(main = "", left = unit(4, "lines"), right = unit(4, "lines"), top = unit(3, "lines"), bottom = unit(4, "lines"), gp = gpar()) { pushViewport(viewport( layout = grid.layout( nrow = 4, ncol = 3, widths = unit.c(left, # space unit(1, "npc") - left - right, # plot right), # space heights = unit.c( top, # title unit(1, "lines"), # space unit(1, "npc") - unit(1, "lines") - top - 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(0, "lines"), top = unit(3, "lines"), bottom = unit(4, "lines"), gp = gpar()) { pushViewport(viewport( layout = grid.layout( nrow = 4, ncol = 3, widths = unit.c(# space left, # plot unit(1, "npc") - left - right, # space right), heights = unit.c( # title top, # space unit(1, "lines"), # plot unit(1, "npc") - unit(1, "lines") - top - bottom, # space bottom ) ), 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( # plot unit(1, "npc") - unit(8, "lines"), # space unit(1, "lines"), # colorkey unit(1, "lines") ), # plot heights = unit.c(unit(1, "npc")) ))) 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) } .grid_image <- function(x, zlim, col = grDevices::gray.colors(12), prop = FALSE, interpolate = 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 } ## 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.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) } grid.raster( .map_color(x, col), interpolate = interpolate, 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) } .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/register_DendSer.R0000644000176200001440000001067014054076232016032 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyright (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() { check_installed("DendSer") ## 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.md0000644000176200001440000002403214201234400013334 0ustar liggesusers# seriation 1.3-2 (2/10/2022) ## Changes * Improved argument checking for ser_permutation_vector(). * ggplot uses now standard ggplot2 color palettes. # seriation 1.3-1 (10/15/2021) ## New Features * added seriation based on 1D t-SNE embedding. * added seriation based on 1D UMAP embedding. * added seriation based on OPTICS. # Changes * VAT plots now default to upper_tri = TRUE to show the whole matrix. # seriation 1.3-0 (06/29/2021) ## Changes * Plotting - Most plotting functions have now a common interface. This changed many parameters. - hmap now uses heatmap from package stats. - dissplot shows now averages in the top triangles. - improved layout (less white space) for grid-based plots. * Registry - list_seriation_methods and list_criterion_methods without kind return now a list. - show_seriation_methods and show_criterion_methods are deprecated * Other Changes - criterion returns now NA with a warning for ME for non-positive matrices (used to stop with an error). - dependency dendextend is now only suggested (used for testing). - get_order now returns also labels. - hclust-based seriations now defaults for linkage to complete instead of average. ## New Features * Plotting - Major refactoring of plotting functions to provide a more consistent interface. - added ggplot2-based plots, ggimage, gghmap, ggVAT, ggiVAT, ggbertinplot, ggdissplot. - colors are now more consistent and all have bias and power. * Seriation methods - seriate for matrix has now method "Heatmap". - seriate now accepts data.frames and used method "heatmap" as the default. - added seriation method "Reverse" for reverse identity order. * Permutation - permute for matrix-like objects gained parameter margin. - permute for data.frame works now identical to permute for matrix. # seriation 1.2-9 (09/29/2020) * removed dependency on methods. * added DOIs. # 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. * Seriation 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, grays) 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/MD50000644000176200001440000001463014201253523012560 0ustar liggesusersea14fd967f683a78ae0892948696a157 *DESCRIPTION 7bc55d401491008d60a475ac98ad4a99 *NAMESPACE 462785a0b4d0e3bb98cf22015028c01d *NEWS.md 29ea472b71c0663c92b507ddc66cb697 *R/AAAregistry.R 2e3d1553e466f8327b4a78eb189ff1f7 *R/VAT.R bfae8a65d60e640e4ad2ccad8347793f *R/bea.R 87bf048950df5f1d4f976ee2df343989 *R/bertinplot.R e8488223eb244ac6fc647b85602bb676 *R/check_installed.R 815fb2f4fedeb74a5f3bf1698e485fb3 *R/colors.R 90936c730ec141f06d3224821e9e9efe *R/criterion.R 28000ce41f3d211b56d8c3725bb9cf5f *R/criterion.array.R 7148282eb2e5b02d19278bececb0bf0e *R/criterion.dist.R 8acac82f924980d0b4ba49562b91fc83 *R/criterion.matrix.R f5e7d0c5c63b9f0f45b39fc1ebc86ce3 *R/data.R a70927425d5455173f604226829813d9 *R/dissimilartiy.R 1f963f77edc52b677ed6abab440a4e54 *R/dissplot.R f3c6827200e3d9ca90e38a45964c7924 *R/ggVAT.R be0676b5610f96229812f6b3636e2c17 *R/ggbertinplot.R 56c73d734aaa8bc43c00c428295b04b1 *R/ggdissplot.R 77808d6303ab0a77718048cba8bd9098 *R/gghmap.R 176fa4c42469db49f2b9b2815e088104 *R/ggpimage.R 17afc950dbbe51004fae1fa958f33c52 *R/grid_helpers.R 26e9ab4a7fa1ceec493d33bf50116166 *R/hclust_greedy.R 7d5b711c93150f6da26be110f0ddeb9a *R/hmap.R 62f9fa022041f290faa686b43ca19917 *R/map.R 1a5ff19ee7e8aa8c36beb9666407b09b *R/parameters.R e7459f27744912c0ec0fe841e41d4d6d *R/permutation.R 73ae617c4805866c8acb849dc2bab1f3 *R/permutation_vector.R 5cd6eb34a88394746dd2e5c43ca850db *R/permute.R 7094e28d07b34edbf32d12c4bee0ee02 *R/pimage.R 9e2be2e09512cecb7fe331c58fc3f1c5 *R/register_DendSer.R 0badfb8d3b43876721108e13aea5023d *R/register_GA.R 8fd426ffe73e5175e77e384441528868 *R/register_optics.R 8891eb03da6e95953b97da805f6fd456 *R/register_tsne.R fd523947e41354990559aa572388785c *R/register_umap.R d5896c59a34ce833c6686453a25ab4ce *R/reorder.hclust.R d58a6acf275d1339ceb609e02c82489e *R/robinson.R 1287a116c1221558cf82d0139d98ddd0 *R/seriate.R 482c54c2fd3df92f08ab52e3bc8ff411 *R/seriate.array.R bd454629f6b9a3d52597a757dba69306 *R/seriate.data.frame.R aeafbab65fd6e70d4b331ce75d608b23 *R/seriate.dist.R 3d06b39617c4fe4ed6a00a85ded8db99 *R/seriate.matrix.R 39c8f0dbe15b8def1e26a2ca510bc5ae *R/seriate_ARSA_Branch-Bound.R 6041763e6adbf541fba9c30557ae4042 *R/seriate_BEA.R 25dd8d12c7a9f30f8fb89dad77d01bb9 *R/seriate_HC.R 4673e358d646565394f16e399a27519d *R/seriate_MDS.R 0b86826e07039f1f7bbd59f8a1817149 *R/seriate_PCA.R 2fd9282db55ae067acdf1ea91e79d46b *R/seriate_QAP.R c47f01a81ed53c0d9f59b8d448e8d3a8 *R/seriate_R2E.R 41ffbab509b56f06fd76b60414eaa455 *R/seriate_SA.R 2693e1c095db6b666177d953efee3e77 *R/seriate_SPIN.R af98044e758468ea5f9d5634a84af003 *R/seriate_TSP.R e91ee9e2afacc526b8867e48c1ceb64e *R/seriate_VAT.R ca018f4a9b47eccff38635dd2be9fe2e *R/seriate_heatmap.R 101c3591535b624d3ae59d8ad5449d61 *R/seriate_spectral.R 06f9e1c66ec9b5425ec03787c643ce11 *R/uniscale.R 8b1c874334b21126fbe5c2da58c467ee *README.md 721451005d7ee94f2c7189d8ab1d0827 *build/partial.rdb ee1384274a4ef7c8d7ab3364278347e2 *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 90d7ad2e5eb547ca59c0aef98b1990ff *inst/CITATION cd09534925b14bfc5ca2a4998404129f *inst/doc/seriation.R 2089805811e1869148e3b180337e9fe2 *inst/doc/seriation.Rnw 2a6863d96e41920072f2758794014743 *inst/doc/seriation.pdf cc454e236e0c9d39366601ed888a3705 *man/Chameleon.Rd 928cdf6c55993eaf852f764ba6718bd5 *man/Irish.Rd 0705c259c1db15283255ea4592526773 *man/Munsingen.Rd e1288449e557db8faa5ccd98722de65c *man/Psych24.Rd 52a25abc501289d3628b58c716d6bb0a *man/SupremeCourt.Rd 338c48041a9cbfc028ab7620b3d506b3 *man/Townships.Rd 8c7cf0773418ad1c9e36c80ca8fcba7d *man/VAT.Rd 17960f6d9017ab43aac393ff29fd945c *man/Wood.Rd 6ccf100898941ff2a26e0dfec82317dd *man/Zoo.Rd d561280ad0e6ad055d72e105d34cfabf *man/bertinplot.Rd 00e90624cd01a17d164b6501b413acde *man/colors.Rd 506b10bab822475d3082cf841b670cbd *man/criterion.Rd 1fe5cb38b759c70c70b15bfd5c6fa7c7 *man/criterion_methods.Rd 0d3321cb05f8e82c7f5c6f95d1b338eb *man/data.Rd a407fda6978e9ffb3764f9b92e8dcf69 *man/dissimilarity.Rd f57b941ce59c8147793ae47a097ba30f *man/dissplot.Rd bf5f30d674422f4e5d07a1225d4ef596 *man/get_order.Rd 1a788b85b63f6af9fcdd7ee7442c81a7 *man/hmap.Rd c663de9add9f48a7aaf2d17673a9f1e5 *man/permutation.Rd 384d6b2d0b99a5e1e435cc574c23ec1c *man/permutation_matrix.Rd e80b98b4fd0fa8f9a1fa22629bb881e3 *man/permutation_vector.Rd 1c7b73c72343b5beeb8e2621fdb6ef8e *man/permute.Rd b8d5f601dd2ff19fed0d52ef0ce9c05a *man/pimage.Rd b63a40a4fa99b07f24a5ba8f2e1a4ab1 *man/register_DendSer.Rd 80d35cef7d216f330a61b7adc4b362a0 *man/register_GA.Rd 6cccdf2e0f1ec967ac4b6a0dab811387 *man/register_optics.Rd 2aa91983b1b6932ef001edaa50f1497c *man/register_tsne.Rd 554f07ba76c94d83aae29ecf2944eee9 *man/register_umap.Rd ccb67a35eca32f8d36a901bde37d126d *man/reorder_hclust.Rd fda05177afa873f740693a1d7b4edcd0 *man/robinson.Rd fceac8f4da2969c0d56cf4d572cdf86b *man/seriate.Rd 42f243659a9e51ea55adceaca6d3e579 *man/seriation_methods.Rd 277bf716dd7afe96e39412bbb296674b *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 864f3f7170c4b5a0c45de4aad8a90234 *tests/testthat/test-map.R ed96c5a1ed8875c89e680ee19d5ba910 *tests/testthat/test-permuation_vector.R c6c3d01f0698b5fec658878b9527efb3 *tests/testthat/test-seriate.R b59872d48cf446767be0c79dae8900f8 *vignettes/classes.odg 7f67ca8c5483222bc0a154258388db86 *vignettes/classes.pdf 2089805811e1869148e3b180337e9fe2 *vignettes/seriation.Rnw 17446bf1c953326c0ee62c31ceae93cf *vignettes/seriation.bib seriation/inst/0000755000176200001440000000000014201240332013213 5ustar liggesusersseriation/inst/doc/0000755000176200001440000000000014201240332013760 5ustar liggesusersseriation/inst/doc/seriation.R0000644000176200001440000002662314201240332016111 0ustar liggesusers### R code from vignette source 'seriation.Rnw' ################################################### ### 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", prop = FALSE) ################################################### ### code chunk number 10: pimage2-2 ################################################### o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) ################################################### ### 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 ################################################### list_seriation_methods("dist") list_seriation_methods("matrix") ################################################### ### code chunk number 18: seriation.Rnw:1315-1316 ################################################### get_seriation_method("dist", name = "ARSA") ################################################### ### code chunk number 19: seriation.Rnw:1332-1335 ################################################### seriation_method_reverse <- function(x, control = NULL) { lapply(dim(x), function(n) rev(seq(n))) } ################################################### ### code chunk number 20: seriation.Rnw:1343-1348 ################################################### set_seriation_method("matrix", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_Reverse", seriation_method_reverse, "Reverse identity order") ################################################### ### code chunk number 21: seriation.Rnw:1353-1360 ################################################### list_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "New_Reverse") o get_order(o, 1) get_order(o, 2) ################################################### ### code chunk number 22: seriation.Rnw:1394-1395 ################################################### x <- scale(x, center = FALSE) ################################################### ### code chunk number 23: seriation.Rnw:1402-1403 (eval = FALSE) ################################################### ## hmap(x, margin = c(7, 4), cexCol = 1, row_labels = FALSE) ################################################### ### code chunk number 24: seriation.Rnw:1413-1414 (eval = FALSE) ################################################### ## hmap(x, method = "MDS") ################################################### ### code chunk number 25: seriation.Rnw:1424-1429 ################################################### #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), row_labels = FALSE, cexCol = 1) tmp <- dev.off() ################################################### ### code chunk number 26: seriation.Rnw:1431-1434 ################################################### pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() ################################################### ### code chunk number 27: seriation.Rnw:1500-1502 ################################################### data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) ################################################### ### code chunk number 28: seriation.Rnw:1512-1517 ################################################### 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:1521-1526 ################################################### get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_method = "TSP") o ################################################### ### code chunk number 30: seriation.Rnw:1531-1533 (eval = FALSE) ################################################### ## bertinplot(orig_matrix) ## bertinplot(orig_matrix, o) ################################################### ### code chunk number 31: bertin1 ################################################### bertinplot(orig_matrix) ################################################### ### code chunk number 32: bertin2 ################################################### bertinplot(orig_matrix, o) ################################################### ### code chunk number 33: binary1 ################################################### data("Townships") bertinplot(Townships, panel = panel.tiles) ################################################### ### code chunk number 34: seriation.Rnw:1610-1612 ################################################### ## to get consistent results set.seed(5) ################################################### ### code chunk number 35: binary2 ################################################### o <- seriate(Townships, method = "BEA", control = list(rep = 10)) bertinplot(Townships, o, panel = panel.tiles) ################################################### ### code chunk number 36: seriation.Rnw:1651-1655 ################################################### rbind( original = criterion(Townships), reordered = criterion(Townships, o) ) ################################################### ### code chunk number 37: seriation.Rnw:1722-1726 ################################################### data("iris") iris <- iris[sample(seq_len(nrow(iris))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, method = "euclidean") ################################################### ### code chunk number 38: dissplot1 (eval = FALSE) ################################################### ## ## plot original matrix ## dissplot(d_iris, method = NA) ################################################### ### code chunk number 39: dissplot2 (eval = FALSE) ################################################### ## ## plot reordered matrix ## dissplot(d_iris, main = "Dissimilarity plot with seriation") ################################################### ### code chunk number 40: seriation.Rnw:1748-1754 ################################################### pdf(file = "seriation-dissplot1.pdf") ## plot original matrix dissplot(d_iris, method = NA) tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") ## plot reordered matrix dissplot(d_iris, main = "Dissimilarity plot with seriation") tmp <- dev.off() ################################################### ### code chunk number 41: seriation.Rnw:1781-1782 ################################################### set.seed(1234) ################################################### ### code chunk number 42: seriation.Rnw:1784-1786 ################################################### l <- kmeans(x_iris, 10)$cluster #$ ################################################### ### code chunk number 43: dissplot3 (eval = FALSE) ################################################### ## res <- dissplot(d_iris, labels = l, ## main = "Dissimilarity plot - standard") ################################################### ### code chunk number 44: seriation.Rnw:1799-1812 ################################################### pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering res <- dissplot(d_iris, labels = l, main = "Dissimilarity plot - standard") tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) tmp <- dev.off() ################################################### ### code chunk number 45: seriation.Rnw:1827-1828 ################################################### res ################################################### ### code chunk number 46: seriation.Rnw:1847-1849 (eval = FALSE) ################################################### ## plot(res, options = list(main = "Seriation - threshold", ## threshold = 3)) ################################################### ### code chunk number 47: seriation.Rnw:1863-1866 ################################################### #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ ################################################### ### code chunk number 48: ruspini ################################################### data("ruspini", package = "cluster") d <- dist(ruspini) l <- kmeans(ruspini, 3)$cluster dissplot(d, labels = l) seriation/inst/doc/seriation.pdf0000644000176200001440000121216714201240333016463 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4738 /Filter /FlateDecode /N 84 /First 706 >> stream x\[w6~?ow5=kmڮ>02mTrm(Qe[I:g4l+(yfQYg`I!=˙RI]X\bzd. %$)C SyZL:Q@$g f]I혒Y'R2 .G dqr 沠Xg {3-X!pSKV@n@LkɣnXF[V04-@ot.Z cY8aA4T8)=Ia3 I Ԇ88e08q1 Ze1 %EH9ae̚e AŴIYV`([`tsI#6/ @ LN48PvAyFS̃3Eu@9IO==(c/,M'A`paռjR@+}} q4o) jĞ٨~˞ͧ {2w߲i=krætUԓ񃲩؝)^HqW 9jyz>͐ d:qYdz6cw˷ *}fRs2|rޤ H]x:9*x|=Nfl07Ȭ94_WMS/!X=fg;v4fOMI0X3aͰw%oq?ZmYC(B E/SEX-qNNu+RH^H$2Oϵ#}Ull5ZTv]|^Kخ.L*#=#Lj[NxI ʴU*oČĎ2L )GJ/bA_*|ɛe9䌔TQSi렄S HvR}Mhڗ(&?k+"fH [ѡE 9z t/'Ƈ6sXF9Et#K8BÂ2'c.ӪXrE3DSP=BX3tFOtF(`*ʿ/u6 ̲ObV19$w!̟_WO)K`2x 9<}98_!5Ƽ_1C {󪞜?Is53>>Kِ7N7'|?MPN_wѨ 40Ͻv{<zToT]zY^V[y),zp4"CK/ +!',\9m˟2pg9ɋX4$TIgu&]ٵuuufiБT,,:K\5~ !EGng+*QyMyUqb5D J8h9pAwg:4l m_'/g*u-I' TO5 2UФkJ:LU}Vhhtn*%$^HOg$+jZ%$Ѭq!ȡ;S8X =p"/ˎg$pAѓ 4I6<{; L-we]$p=2W+sxٛN[k h<}qx&K&heq]q Q0,X?ί`wVgvVgAdyʾˆ tߤRtHM1Yg-L/mM꿁VϏvZu/EV\.[tl&vmJ+t1phj=x4\,d g-h?nyzG‘yb߅¦cVg#SBn1:?42_Nw]*KlNn=Z[6i/V{;,_DS/foZR+lJNсۦ:(l,z>bW# 1 CĘx<"];#"IQĺ66l`(6 5ORΒVU_g®P]3r&zNiD,k&ޯ/M75T]ʓB[ !JbmHG푺[|))r~C:M v?٣v}qQ_w$/7 uF?S-=BDz+MgE03(@,lJ( :v1W0mNU3õ.غ͢ \ L pmqEӉ~_h;evu֧it< -4ֈ"PkskО3'.w4j`i2]F g2 dXO9\*CcM0ΊҔy&BY!"Ϥ눤tɭ,K!Ѕo!I_2I)F<"eTFvnk@<[ɫP `r}/|F6`͌֓I<.aX4_IKA|„+fK',~gT3aHmUm؂2h՗6wӦ'tm6Zg[mK@i,2ecx=(V|)n꽕6g(3Ml BҎ%$mbX$!2fBg.v|tt') \Y=b9ͥ zvYnCmW3WE8v$y,4+1rJU}%Ify~Y-+{>g[QL9u[oz9p3_Pd3S.˂t4=S]a 9ZL/y{n{S?Գâ~ܬ$âmRr6Uln[%;Ϸ׋E`lY [Re 1LծZ%ޤ6EG^u;j ՗O~yӕfdJ~b|ظca¡`a0j 9X>/gq_*&C]E&G(KnP(a}˽1) nKDJC  v?. ]fZ/=Jpga#`WƯ7f9mǢF%\QZN(N /GƊ ^c{N!I5Pr?~1kf69?(kq-CB0}.eU=_1aA?,) H'άSО֯>]M+Dcק74a<9ԿiLih9"߭t!Diߍ@lX߀ѬdLҫ5X!c1(f,D9@mZ*`xwp2$VE0[yMhˋU|O?T&"Ғ+ק3)W,Q3r@ϣ*]γl~-'V@-g@/~0wAد/`(Ie~D*$G:&_$yVJ  TP`Ȓh,a"G Lq i{;`M@A}~^M1m-7_/":AHRÂʍC3ao4]~ DYAtxV@4魵l-GtآH!%VIQNXo%D+m^,lzPK[FQ ]7b4ol?fmendstream endobj 86 0 obj << /Subtype /XML /Type /Metadata /Length 1554 >> stream GPL Ghostscript 9.54.0 combinatorial data analysis, seriation, permutation, R 2022-02-10T10:44:10-06:00 2022-02-10T10:44:10-06:00 LaTeX with hyperref Getting Things in Order: An Introduction to the R Package seriationMichael Hahsler, Kurt Hornik, Christian Buchta endstream endobj 87 0 obj << /Type /ObjStm /Length 2999 /Filter /FlateDecode /N 84 /First 756 >> stream x[r}WcR.ϭ{nU.WH(rHA@Y jv3U(OU*NEr9c D}R.E+NQF{_׭W>X,+ ƧlTdyYeSgŌS}WTRANJ}A1{a"*"M'oe92n oy3;HxG :*(*'6Z\$YE p1'GVE\M#13@Ɋ8[ o"8EJMJEПLtx}[UfT"(f sN4g$Jʎ %$|=<UYKLH DhL3i" '2s"#'av =]%FQ2OT)JE'" O-$2$W"_~At1W;X̸r7vFWG_G#1Ա#VGɢ Es2<~7j(ALK /3:渙O/gf.r6j d^>>Ruq ?O:mp{QqdeU\eU\eU\e::Vzl`wŴbW|eW|eW|eW|TS^LQU2G9Qe*sT9Wz\qǕWz\qǛw%,a=NYm7o~׿DE%mor9˼f((ym!U! JE3*s6l|hA<M~_j5yDŴFTEH'c L"MSe ŵV +cI)ڃTޱ䋥HNHeyY-cq^#Y$ ZA[ dZ9,oK Rw7 5 βFe(96ylM=rb8g a`RV^GxCܲ[/T:#.-AyH*"T hQt14(StA^AEK; $pZ K4:4hP};m!Alh )2Wut&'D |yZ*HZCb"{Foc2 IPF"lHmp`e .sx-!1=MT_4ԯbhѮ{N(YZt Z:]jo[HlfB¥ H[Bn@+E;.T+PX63!  ,gB 1^F]E-A,|#PQXYGtY('K ZָIx ye=`[y8rBZ\]DXAɣ v+L>*a~o;0&5J~f"|n5lQSƲL:CML,&"hPj  )5($h6_zŔEu(W 8KITLŴ1{tu}brI*gO(9) 'oH )AEs#-[:prgCUB&!ǸeȄs{zao"C i/_`q؋ Hxw׋A@Z%@q)ڰoeH@x~"RBGV=}tj׸N0ɉn1Ճ`rNgP@AMR kP!@mXaΡA`R"E `޴9=b:& g?nN/ǃ2O&hr̛d>Z?8GgE%> stream x[rF}߯JsUReI؊JIl` E${z Q%0rtLCz0e,Yipug}`Rƈ~&I@)g%H?Ŕ ͔M BPf˴22m#B:3R9$"3ڡz3V#Oxzb&JzaVPeC1k%Yg)s`64h1%sRX$$sʢB1gO #a#a!T1/R)ϼL:+Bޢ%%bQR1NI͂0 eAk ]II8,0zz`TdQSqXm)"iI)bЀ,1PfHH-H#H)O/! мB)cMDxP\]y5X\A*˫*ɢN|֌+j?|FTXAk %S`EM&A>c%Jwg<"~vtEy/w9UuiYvFQegTUvFQpT)U GQe}O>m:K>ItJ֊py<ǽ߼9Mnv(ŋ^~}?O~<\ ׌6φl~x\|6iJ ՛~Ib X䥵N\(jG\43hd0QNDҝJ=啞ToPҨW /??o[To~9k~oc>#>~ǧ|$fJ~<_` 1TTJ/v(^9ѣc8G(GA~:@.ky~+ _]5.we &^|9>g[S/6hP2m<֟Y՟WӇo3ƪ>@ h*Po*AlxmzhCj?9r{9uklsr!x!wmO~QosD.<9_]bpI_>Jd& a ~~*ߒ|*x7|:ن.{ڔj)?K9l껙\m]ʲ֨P=\ZYN_`4ySis#VDBmmՐ/EabݪeiK6ba6^7^{Nۆl9{}Ղ^& =CYKiWN!Y54K%:ʋ}=ìwnuӎU2ЯJ/ZPl`Iڦόߛ (TH+(>|#W= "Km"dq0oHWFa0.Aa"s@I4eR=:)W=.6Vy'GBU~]T'O8,oƥKN`-0XX:l LŌ<fYaN =7`he\}:(]Ic-*P+`2:< }bرMNeB1VЁ+Y4]$ϲr ΌdE^nɊ`d0i us/L4툖lfHRcYM(-m= uxOϿ6 X3Tɜ tx#tTh]݈$e$)fgHx7! ՍbǗ''[[Y;.4ڔJ-V9֓òiqNqrCr j藈0iqhG`b_&93g_;al5m V}N L>!E$1+U,,Wz:)i3JdVA.g{TR5PL];xN,=ayp5dEr''Pu/Iwu|+p^0+P @:1LC*r>ƨ8Nzz JF&D$[;2 18oY4Ktry3EDwo/~Q~ DL> XU~kMJL|oCD7S[ t瑽sҧ :{tO/,p T},xZ)<(=ĕ^rA Zr06B&} JEK~PeБٲ(D= vHL\ m`T*Q[V4Cb\8pe6)*}=^RIAw(ZOB֋nc]Muuxp۟j >VYP0Pb!Y%S[Eg%S>Ov[=ePO+CZ6Yj&[2eys;Dq4L'wHmtvN |1G/ neڴߣ(KV,wI}٥1Rʮ)e8%QK9ڦ63) fTNԕ[]|C>χ~m?L.BTA-6گ2~k-}b_cy!S4as*0R^RvT/E bNWDzK)ji7}VeDz~K $e(aRAў 0J23_xxZ_w=>3\8kv>=ԉ"`adԗrުJ>F<[D gA|ܓ-Y-~Xy`lLAMvendstream endobj 257 0 obj << /Type /ObjStm /Length 2878 /Filter /FlateDecode /N 84 /First 768 >> stream x[nG}߯|Y_6vbH"4+qCI޿S==ԐC #qdAsTu˸(0. 0^ KG-8"{+R '$v m&G8 CDkLQ -Nh+ %<܅64D>oCVn k4IZ`1gm F##Za>H؈7Й eAq|Ԙ91Da2) pY#m c` )~գ|^gQ$[ Փ|]`*|z]O'_^C+!O$-1xdDCuRgJ𗞡lٛ^gz[]j6H6~9r{@Ǒ@AZն]9r B! Ц6lͱ(%=fXalaCEPlC6=B걄lg孄|XQ \S7n ʎIST$3]%E%/!'FP'QvF-.,L<螴XndQY'`Ⱥʵ8kw)r6֏ɺy^nP0V}Yy6 gRq,l&m 9Ѱ Fɲu^r7qr| +z7e} $:q P Y2Q"N89drJ6WHje $N &Sx))4&lʼ1iOHl٤Iܠ|g|Lm#I|v 0M,fwkO7'J #Y|'d>?[O}:4_Mo<.W'h- -W2y対tmdt+eˆi`r^\'wb^G%Uq6X kC2V{aQMO_K~ ǻ*{U>yd?~)V6(_Gw):!~{ICoc{?9:p N92_{ 8\z. AmP:z[MYu^겚VUS5UuU/jYuڱ l_~ԕ`!h]C"F˅|.̆Q{&իД6n508:&Ee{T@ ct.1% eq(u;u81j6啫F[$YkI^V#*I8n,waHsmP1 s9u{.yq#hDnlW8+y:m4ٿ]b{ MUC/y`5:@W5 bl a> stream xZks_ߚLd*qh2SH aʲPXg=H%Y¤R;f[ SiE3=1#gBྴ,)+htj$O%݂"2=8,Au S.r`x¡SPΚi ?mWy̐n$293{B?bk$4HgU 5~TI¬ ά*q9% HVX`GD3Lr&\9E84Ep48@)Ιi(jQ\1o0o5N hI9-C-J$hiP,&Ԃ+%O_aOc/hxbXY,ЏB23u8>{g?UM{Veoݴ_"c_\fU6yYf)7y6%.XjeUUYd/ٷ!Zeydߢ¢J`\TUN}YZIHaaA [ϊ&2+1S˕Gvo]ZvR}.ESy -[dMs; #ᆢݤhȪ&ǒWy#( FGI}c{ѹ`hdu2)EEVlg'K;G{w OJ=z~8FLG2'uhlV^:79,:G&=h+"DTCtfBȎ|{|f}>3}mT[eܖWI(" J(|X/ȬX/jR EjsX`>aҷ"/nX.zUY].fq VY'󲸂=K7¹C.2z7)_ss|i;7͡}/G>']ɲ"_;W"JGM2)Of+l Ӿ<],$m r;}GDzta_?4*o̼Q8`cAQ:q.DVOc.*w3w;(m{gO?yx!M!j9b/""'vºV?{l@q:TU{) k/ 3R Л U+~9݆O46Ey".U\u\#&O]lqm`E$iڶ mdl-O[{g~E ,J[pz'GוGN28-8t8&/b}XFb8ۡjBi譜rH$^赞tDxy|h߽k~٤Mެnުe 1iWle2-0MI@NJ3k!j{&E5cj6:ɛA{OuA^UV9lĞBtFVID^T=,{&id=i42r(3XIm24$梓 8 bn=k?Æ{$CǕ'/wYA%Ti- lj>'E[ޚh7Rp XؑR n]%>\JP nl qR#<'6^:&oUxzrL3Ewwͤ(3R!/C۔[Gw}D#~G0 M5E, 2>zT0T" *,mO291oԘ~b2`'cK24b~3[8Paj]uL'&-6x_+> stream x;vu{~*AqbIld1") 3l Eɽu hJ& 6UYkeᢻx!p?KZ)E\[g쥓_^.~l~Njyx])gڮ{xYfxlnʩ\^ <y pX֮yHk~Sino,|̟M3s0[&; %8855ƈ?wx`ovJ"@K8a3cуfzcyRc$J"?TT3DF ۼyݿ茒nL[T6t%a(yy%@8xU9хHx_ew|#iÅ 2ϓm4ڴBwoyo}ymW v`fyׯ, L54*v$%!"}?`K6 ɲmK[\O*;? k4x19k:# EԼ+f+]ZdLs| AO玽ai/>nw>)dm(}q'A;Fg}%`lYD8p. H,hn,XDԥ-ER-!IUSJ PF$H[:ҴXs\OJ NrUMh ||"*EEMhp7/ASVq9{ H~>)IQ*~d璸R!!#~GLv@n:gquB2Y4$zTR,Q X5S[in 2= [&xPBR~ ac_k:c4yomt%ĢJH ä:*GmU~D%RAϯ+SQy  Ā*|Vb@H \U)ƶPR@/ȜZ!JFĨE_y@UFfٟd/* H@;.uj*%({e7MDc T(8 SB~%l>6`ΩI}ŬMwqA)NqQ\9~2ciĈU*0~xrJi_"clTbeq~K{Dq~ {bye!bq8>2 ?>Ju`v}7`ˬM]X˫!ҧ~N?T*f֥KԆƔBTnؙD\}^uQ yLu@,){H 봂];7b;x'LXՌ 聜ǂNiqN9A-=$:'K0AAhy?0M\%}s] f6UT@x%%ï`REٟ@bg-0 d@jI= <vJ?˺l9Q$oHKȭzYsvtH: ScvsDW'P C3mV.̪}:b/bc2J<1D45$m?C|xN"(KA_e8RG UvD5%+.! 0VbvMU@>:T_jbY dM$tt8ݡO2p!6)l[OT TRN|XͱMÇsAQU,VK&9D*D5-T '|6oそ9y4Q5Rw;xpӿ-!"me>@M&Dyyf%1)¾UAVj{XT>S紭<rUcGuA>قӆ^gn1ܺ;9%B!kPoH|j#L؈4WH袦f![Mw\Csܜ!_,9Nlq-YFDƑ8 +\3 OS=]`u|3.@ux'-RCbNa) VIS4%#JĚ"0_@f[fE|:S+}KijM#b6I@{tý* (9"v`R6Y4plSTCK!EVCT@֌;e\ez:  b:&9C"m>MqؿJ: Lnc0T4mxu_tw[X̛f=s9?RAJ_C^JK7@bnd3d9GQK[5,Ubx2}6`SDy WѻkGo `S>%;fR<1Jl)b;9Yt]ty>)6 rK cUSX&1QTϒa!;J9OQԍHʬp"C! ȧԺf7 hV`_w` #]r_ ^i4) :7WMbi?dzSRr@e灢9 _$OM}:=фX#OlN$P+`4ςzW0EEdD*b!vDLuy…Z;բyL3s9gжO(!E4%!.}I8h fVXt%~%r癑%NЖa\ɚͲ͢Lov4(qZ35TyN&fj\X)bfZĬ'Н' p%!:qSeLJseђ8T@yzˬ%ryoKcL8]fĻ-uL#مP\p!u|vԯb@[2tw.aܪS̴~ci|(sj` 8oG&HN"7x.O+oYӛݫſ L?Y縴'njth[ݺWwoyL<Ai5d%R<)Ɠvu/ @!jW @sz]E)ڿ3N\lO'u~C uˍ}~eh-TL=FT JϵCu =Kxk0#*T1E*e{,?V#B疘Ro V`{!'f4t"S*:eKU-+C/VP |ZaY]ڃF$21A=oR"vW.>,Uv1-`PE%Ht0;OU8ji_5FpJtŲٴxnz֫yE{B A΄ڗ tF4x_~gDx2]Ʃ@ߘO|Wpב xC90\-l&B4,nClC4(2.ڬ=5zލ‚Ca{tXXܞXSNMx\5:ĐZ:xy3endstream endobj 425 0 obj << /Filter /FlateDecode /Length 5824 >> stream x\KqOo#jTxJ+yWD@P䐳v59Klg&*#Hd~~>ZvYw~u^wq4uco|vnٹQuB_xmj =..^4fNYfmN*'m6[!x\s#:vیHjwЬyvLZe7{"Pqtu4 (d $tsK8M{:a?OiW,-/veʈj`p$95^(򝦱4Q5?UwK z҄hN>hDsui@p8D|l7; )x3} pj(L6*57AzYbvLJ:~~?_L="B] Gqx 'k~&CdPippJ(~kߐ(آ  C}x2?;ڿd߮ii;f0xQ;&]ڐ~F:"rKdĀT;Z{8 ]k\aۡJ6w oC{ɛI~LnHx](#<84Uj?G8M^F 1 K ,U6+ݹL<8;SǁO)!dWl&n äYg5'TYM3~;=4pD)6rUPP9M3t, dxp3R&2t-!1m{239T 'H׉x)0 BRhF`Wc ЪLCe24*U[΋\t-7ԇnX9$㝟/N(:X̒z=%4:?rAM+'VOqyθ[!c0QbY⏱.#mFM*YE˨̻T<#&KNIij3r͞"շDeN:ī<~w4ucqXM(. ǘ}vyar8hu+'_0P_U K}1ZOxw̦?. Kڄ]Kʳi>N97qC:*N'DhܢmASk#Hb'[hh.xp8C .z mj{$Pj 8ܸ?޶r[@8W^}n1KJnῈ&ҵڰl\L&G!nZq+߶ 5.6Vda&DȔ2U(PJɾ_ hB::A bߏ~&81KɥdxPD1S)0tַZ@OοOH!CTtPoeXgl :C3nDT b\Bi/d۵@ X̗¸j.Ø8)}C7 @q:]{%O\M`Q$:lD<Ԧ~2Q=- -%`_:1h|һ˘kLI#܀Jty͟vJ-r.$U /W& m Up~U~ZK"wjJh !;[_,[X(K |L z xO߇{= ŠYd!& ~_Rp9Č@oذt|x{}l+L\mC c IzPPshMqne~LTm~[YYrڏKV,]YAL`J*Vy cjanYIk'_? 1y `SW zdbGfPu k)eSIv;oB } |fHY " 'JuK +R(4"6̛Z.晞&`zQ PyZ QCVKFN' _4_o@WQQ sgqA2![i磻v+WAw@`FYK X6RYrS[PW"\I C 3zYmcܪ9R=`,,IRBI|trImm#w뛉EKEP3PItr\IW=۠9b!zEh;꾉(;(vQ|RŚVE(Rv{QME:"ܠXޢMߢ[txR/˻(?ډгâ1~7鳩(([_PVqoΗaHH˱R U1hDI1AXrj'#~r`nzNi~GxQ)7P9n RVGy{x1D1 TYFӗR#UpR40n 5}d]W ݝbhEBjE){xsyK@ ƪ/UX1g ,Dl^IKYx#PPDip"I0YZ@iu$<"o|raAa-2xf`_U\+҇V 땑xG~LsO^9'S c5f}X)lK5 ҷE+CL$XKt-O/wHknXA#[V^꒘%xNrJ%A8g=d/ a yD?=0]M@ ]'`@OHt3loOV!=rf{(`zbHctӉOì"7'EO3߆C:MyxIޛ!usp`Uj||Mӛ#BwMQK!}X peڴ,z{H`sm)yYVVfz$?;ERͦ Z)v "E>^q|qf%2_3e܊~%N;vkrEn`Znz5 AXt}-cT0C[PL_6Yupb]y̱zp7l A["|lS3zͨf&%)ow2yw…-KH 3Z#C]%}.7L7Pōl^y VdCu0ۻ MdҐ3T%4p=Ƥ4;WA,lċ:w,C䕆ޕN@<$Ve%8BF嵧}V`MTFh%DP?$9x~|Ta&?LhȳK5Z/T2Ne=?uendstream endobj 426 0 obj << /Filter /FlateDecode /Length 4254 >> stream x[Y~GNa>"%a8Z d?л9dȒ SM6gf!@!u~]eAj /\/]?W_//OwjK,]\Ѕ -um\\n.*|c*]so\^_YHMFphK)0]8gkw^$qQh:-aRV֔XIYK92X}נZ0n_CClf0%*V , jkc-[_.G[XX)SyYřYx$KlCkȯX\MXoM%mM" jk)}yyn=hW .46r _o/^̪.-TV:WPS=)756: }Y+m([h8ЛM-QP^Ӣ^0ôm6#jjF9Jw5"jI8Yg͑U:iͺbea0 -jxՅ_Ý6qZK!l{$$,㲠ϸfA0M Kfl:YAF`B)5NPZ.SD Sl@V$I50Js!ZmRњQarypZs0Q*+3`d.U虭aPo7Òi!1O`9.X  d4YmJ[^4Φ8-נ*\+U|^P ruh]r6Ӡ:V%׸Lg*>94>ϯR]iBrՋD~ک @Ue~Kf:G:mC`e*TaU LMDäˤD\I`]ME0qp 휉^"C }aer~ME,%װwa%nH7. 13ڣP KX^7@wj9,eZLR13(J! mKp'SM1pC!͡k?R\.k*qa-]@(G-zXYkZBS5Bs2]3%_#c&4F]/xĂVAS<>/X?]EDeRDA >zՔUv0F 6 Bf˜s4` h \@* 㡖 UŶX(BfNΩYHͅ@ʪRg&niYrNDHX$lZ,; )f_9 ja{FGf@RQ@Z8'CA|Y\:aY+ɘUO$(×cVse>.2ayzg9-H,8uV`> sNH!x6zwli jWdϏk#8m}X 0_E%;|m{Hk/bj&2ʺ$*M#w[LG!Cկ> e*QPVv)ELk0=as{ HYwb2qr[l h{zcΎ ҭ7Lj]*Q%`2H(pZ؟|}0`}P+&5kߪ67 ;60R{Eg WsnH B vt=wQpԻ n̅-ׁ+z79;-C9v0:b3H0\7msmtN\C$U>Ms.Ko3l]ݢUϽy_ezB _B 0_Y MܲApS]{8LFSWrrg,mL GgMVp) 5;u9\ϒ3Etҏ 9M(%:~*sAw谼:/kYiaGH}A?bo  `V9n0߯|LUw`X,9Nx),#0;[ @z/V$vf>&SqۧΗ9¿o Y&v4cúq/}`Am֬{l1q"l}<݇vaP72KȆuH C|i#+pw4/Ken:7iP"fG)!~)ܯ:xvW?S8t7iEhRNH JGZ/RZ*sf JG8Pϰ!'4JmeO}Azsi횅f@ιm+4mXS*D6٨\ {7XB/:Ӏm8Xdں&Lw MUJN"\2p*Qô``b_(T}W =vu\ڤ5/Y>\g2^sEdf4d!kՇxX#1NxEЉ.0E8Mlۣ0nyNԲ끾 YcKG5Eł@I {`}t<RqL~'s*[&ѽ`E99$l(qo2hL; _]ʎq@Zq7>nuXh>."7ɰ*0QcZT?DāʁYl͵lmȨsfP '?Rǜ3[P꘣5:$|g09;Egptɭ;y];//VQrX} acF*"j5{F }8d 0l<ΏB'.Yy ّ׍=_iKGj[BBs N6O4q;Й( 8˝5f3R֬emxBτɔ(59q:tgI`ŝF dZzPl>遹ֳ>r(Zc[Ot-ڴ G*"*Hti NiyiF/;.)h)Z> stream x\Yܸ ㍨}c9T7b];^a{:b!G-uרKCRGw TMH$_ϛWnoW[xRM+6﮸ojۍ3n\^UٿJnԍQN4mս//aSJMﻴـZm$4ТU/QGjZ%?ɠ/+[W:]}wԴ^~LJta%׍] xb'JZU?]YO_U/OLa*]NX*Xc!s 60VM7*Ĝ5ZVkm9dpÍZUоn,$lp 䡔ıDu{8OJ#UVNCS& 0a*S{Q}Nɛc7/BFrs߾dHQ=2EKqr6"LA H]eGAwȘ=VV@bƘ!5[pBe못@ /L)H֏H ;CЮ"!pH!6GI3x}04qND~Zh&M8+nfN m4H[kZM^U.@]7?Ps6 zBM tmqg`- JֶK)&S:j累 ;c [T`>I5_F'5Jd@B'N;T [~"[KN@s4fN4šZzI[%DƂz|}{8f@yO -1ЙTlv7&Z8ld'fSR4eg6vHk ڒH L;qzM003T"Mf\SS)`w^ h"At~ ܍ҴYYc[#cՎ X FlsA!h-HV BH)&-ɃA#9H8Dl|E6/L!Ljl /9.7bM& Ǫ9Q+| 7֔|s49dFԎ5y[VNvg݁9GrȘƃmZa8_6 T-ȪC0T|U`9iwBM8,LkW=XX@ `!b'b._zR5+Voj(*0s@5$Èb";ߍm}sm ϩDZfG#wO}`%pQRm\yO?b)40"Uɫ;DE][u!MkG̝TRg(x`,Nqvj8%VVl;.d_2ciu%0\OoG.t+gV@aTc̴7tJۑ__yם'^6˓/k/=~h*~z"EblgE؅Ͷ* 9 ZG`\p YH&H+;s(( s~{~:7pF͏ >s,m"^Pƫ>U:} &@E=p)|ifɡV'99t<}H}=8d13zSJZmk ^۝iW?]0NtߎwdBf)̪D8)8>Dq2U1vB!E3Xϋ(,:W40h@(Jc/d/]OW.|{,a5 S)Okw¹)C!yڂ|]Obj=85q2"(iN#ϚEr f~AO0XFppVGNA}5rQNV%FT*e|F9_#NMǫ Tp@QK1Kccےo0'~ߒmz`:-@%N\r caϓjڒ)z6 6eyTq9a$Bl3w]C1ЯSK4z j#ef) &82+<7AnH24HL}bf;RSO #%L`yA(G 3 G7&BKڤhg4%֮p@JW`OZ0nku(%2 .]?!GF JORYH5UL?>!PGtx@;^-0XPbJY ]p,QnH'G~3  a?O.s@S"X=-j%]5ÒCwKPK,/0e71IBؿIu`Ko^<_mi*E=6.0P>6?)mnQa|K,ov=pPt ӰݗP$cً4:yA(]B'Eڤu /Wa?lbZH̓_ Vtǥ)}E/k%9]2xU}kPf(3>R5q3 - I"s8OԣRHsٜSNW xWE0pT+EPȽ1&.^;N+AJ*i /qP"%5ϯHEH9b){h@2>{Ltc?%}CjH!iZBE*T`dmyv,i_D2RڅLChgMxcL8wq+3L; Zl&\<ǝIkc2[{;qv5/5]T^1.ͷP'J!B6m xw&--Vw!\%\tlXΓԱATߟҖӯ2D-sJՈ]$wCr-:\>W=pWyp)9D*{H]圖i(js-kM96K6;E)ӼbI%bCmc1D W ߒM,ɋ #.Gz:j$=+XLwA4N ^R)&K/~M'ԫu̜Pt(M Ɔ p!H3ZKC(be8b̽K$ kXEIl_6/8cYڭ_9afCtL"n~ \G;nHJyb}w\#0\5KSm gd~s\X0nI"CʆbQOQe]!;u*X> stream x[wܶrjۧeOGv8qlv$ˬw =wfp1 N^qf7qϷGѯGηǧgG}YYxE-)XT&t}\29>Ξ+[_yaT):k.WkjʋBeOx؀jm$ 0V2csBdTS ٓENW6{o}njSg7ѷ$$ -loV:{2E,l. J(SjuocйV☵U^Wx@pיWkSx|s3lBgm}Zfkrkz'0 dwԕd\xFkzI +[BQ--ѳykGb /6.R0]f `&;h[B"0#JD$ RY5J8͕[JkenT@u^ԕk~xvٷ0rpRQ:lnWfX֪*rY@U[;܀WR[n}C7P[@9dDF PkCV:^^hCDvk(4>ϾV*,gx N]Gv`.ʙ?N&U|Jw_3; {Z[$ *87 8؈Ħ.lrpiIL (J9㏏A9~XK>\I1:~ȹ{!l 8icm :ngG:oLcf''WկHY0lڵ*8W,6C %]E:FE^%9d5$A|,vYq qO!:RU' #J;cf?Cf-^GJBfxK_%䮆Yu A86FS;hSd[퓳tR=yV?btn>RJ6:9 w31[J䟖5*K5qGݐm3 33. xQd*pc٫}øKU1aL.vn9yW*Z'(2@.!4f3Y@c j͹'ːG㆓FH b v <,>,5|&Mr #SPFܖ؀oJ4gRK(qy炄2Mjut8isU'Fw/Pt.67^+Y_pR,yaW@Q<V2(jѽ_*;w_GrUؔL2ǂsJBB=2YU^6#W*;l 5e rL#SжHlq7F+>IOtxS1F I`+!|j(al]L7肥ldpIt!b! ![Z*~{3 ᒆM1,EVK{Ms¦/_~@5{9|r\+2x3БS$)(ՠD jץV\NeO: JVwDץlm7N*>h' >apw*\`>r+I-ޘOPFJUK\WyHleZ$o[e4/&k!ETZ><(K-D{~QsmKx |xxgZ|I=R3?\ l `eaZ8LnT!~Hnû-e/t*:3Rڭu͞<(*:)ϔeM2g]r*TwM]0cMhrIv 6>p{! 8jS8$غ77=¾}ە5\/Jx%j%Юh[FPtP9ڙ+EdT?5jMI\e캕n7W _Q|)s ^WSje(1$98xP~1B+S+p l߀uVH(sl,wP4'} l\"񛻨8ӸOk>@.!vv`u#ov.jp)QQK\,SǑ8KA7o$>ܦ(&JsrkTr5M]O66DfD*-8J]/ ,5& |vlO^*p)O͔}C~xF;.(}ߛ%U6O -MpGX 7U׷ ÷/)R5w]DN9_ UQleJɻ"9=zUYԿO`i74ʵie,+ڃWw1[ d sNt܅ iw N0 {.|FXJOJ;k-|X&$oGA,ެ Vߔ:e[l֔n5/Wtɡl "9!Wơ:A;88̟>:~4|NƷK5w'zFCW$~芄egc6wC;8֕{} Exp;:n,OQ2`3Ŋd٠1;Y-$(O`7, 9hN'_towZ"M5~{2LBC(L˗QR7Ke 1G.X8]?8dtR4E+,dyEAU5ya>;jBµ!i>0m}w+Y Vի yp`NCmSL O߉碨޼&\|{Q\˥p[U[ l05drk%ǫ*mu=Df< qu*E觌ZSY{J`)$\P5 Gɺh>M-IeECkjRms1uo2*UE):<8[/n6" 3-2ϘŐ;EIEey]5Xj2hO .z&.ޡI456`Ł;vOtR.< +ߓ9t=Έ0 x[I1r[9v.6rwvoe#k"~us= 'RDT^GU ֮4&wxPgX [`IIM}߇Rh%\Bl~K8y2*{KP2{H$R0x=Y/~f$I1XzNǹoPF ΀9p]L\k зB&$jtc_\G>HZendstream endobj 429 0 obj << /Filter /FlateDecode /Length 534 >> stream x]1n@D{7%o6v"A4T"d33SFro2jn>/k{|\y<>m\7ۧo:>>Rhw.Sk<}}i鿯8X!کZ;V-ځv~w=UAբeaWþZ{١Z!EZEբ,I)P-ChyE;SRSRSRSRSR#cb#cb#cb+h\dYjPM,]0~1BBab"E9xYhgYpgCm xc3d1rR$Ҁ)$\0Kpi`. L¥SI4` 0 L&Ҁ)K:_O7Twjwږ_{gUS endstream endobj 430 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6010 >> stream xXX֞uٝq)`b4QFD ^t)*,H=,H"DUDe$%&ؽ7c o{@lbM{ԕIt8( wAZ*$2Fj²Pi]#~'a'؟7^ƩR-7fk@ly2Fl44- 08#ZGvAa3iAN5,Mg}f e^ؕY&%yYG/0x)\eĻd7NߤՑH8bƝmMcwNr$6?3!4`_z8B<#;ROUPKPEaG9!M%i_ͳn pP-Z9Ovʪ&OM8%vWk;賐7YH}GMh Xn0AEAKBC==C PL$PIwޢg+Kj`t&9DʍB`>l=VHcRB1{N_2 ҳCM/Rն@>bڶfH?>9Nݗ ,)ΘzwFlڶ1i9ᐔk7' KWmϤWrO:72J>"/k3ifoڗBZFN*{/22?vשWYW}LU:Rmux*B!q>|q Ij*JvF r(ukX&ȝvyOChTdA,Ϊy K\7GJic^.q[0WzfQ !haKܰ;3/>בcJz$&Afn$l^yAq<%QB(}h TGq JR^;d0vUԿ,O0,Wpk,:TnMHU{I,cT8(4rgv^G"`E1WYv3[GÊH@K?٢]OQu}R\ } s|k)'lOw@ْ@41ۡ+LET6'l381))ͶX-Y8^(m36[뀤ح!IU.3 bAaL΃:^_ɽ7v /zeg]nb e rя0Oq $!!rQTW)?r6m6> zA8}%u;#l"2Z4~{ˤ0eu^t*gZкߎ$iiL}MÆ(}! e6pmd׃B PʉRYh}]WE=[:٥JIWV>z W+J5 U~~O;uCWc@SI^KcoT'mxU6l1DBޗsp%#'lc9x߀{RϩI_IE) }y]j)f;**>^y/FƝ/={&aoP $#)" e‘?pw[!4J 6b^a&oq٤+s݈=8[4sTC6CR%D CrrHk>|`xFA畧lKNL֋! '?XFT•b vĮَ RƷKFȇz X/uѢfnFQP :^JSkV_ hokO+fn65`. %n\ e=q@sM.hQ_%cxUu)k}+|U,lSVwj ']ӺJy3؊ C.8,xQlGۢ/{׮ 6]J{s\z)VC;Rְب-7eݱ\4b n)-q&aF))kvA{tFb[֖* JmJ/aiO֨I0.>Z϶{ hKY_kM鄝AD?QR&:1gðɨo*?=[5҃wW/>ZoEP2\Wz7oЯ" HΠ~-UD}삽P^!!^/8_饵4fKcEy(*C CzX uB(d4Ha(9cMɖ)^z' 0}MO#9+!kJvY|[F!,olW )3'Йy;RBIKMW.y8,+)b!.ZM(vSsچh`ĤiЏtq?J|S'8 j㰋;Nő摘NxU5&v2+Yj;ag::([+GZ"ioS_e.ca\} @U(7; (z3[I+A ˸YU#3SQy8"-¡8.;0&ecw;r P1=>}>瞌j 2b?}Enbi ,ciAsxGivew˾:jPj81l`7=^)0iO{(GS&g[%{jt3d3LOTZJ| BUFI p7Dq }/0W =f 7>B][z8t~Es"G#M}ۧ6y4{wA k͇h?d/ysB!Uh:i\pb,ᕦ0vJn\5ə:DGRu&-R{5:H48hixڬb7J}wjQB<=WS-QEXjTS2soYYէnL3f[ue+endstream endobj 431 0 obj << /Filter /FlateDecode /Length 685 >> stream x]=n@^ Drߏ ؍A PPa"N KΧe=ߺenr^O~έ;toI۴Oߦu@[?L_/MsNk=}}\k鿷qq耏r~+P5'FxAOU82AwǨ+bjjT5# 39> stream xzw\, ;cW֕E,5֨ 5vEA"E^첇]z KqA@{%$jLb-M&ޘw{gAcnrs~~cysyQ@P|*;_gɓ&عy8+־Rt$Ao!6=5d֜[?A;=qDÝ֣]<}ܭݭ׹mvz1p7PoM 6/ (hq𒐥–;pY*jj7[5k=v{vY_F?z-Cƿmd{N&O:mg̜KQ([j5ZC}@RRRvHʞEFSj=5@6R &j!5L-&R[$j 5ZJMQS4j5ZIOfP6ES AzQlʗCQs?ՏOP(sJL $ *%56RT$R`2ۤT8BXl:4􅙳r%:˸@ϱ={M>tD*BYR` r92ܮZkAzz7ixƘb:b~WP}-+i ӎrXJ̴Ȕ?R9\`☷23!0*;^ aa>w6]ݞTK*WZKzZ !$"V? bd]-xgiћYs%Gca9C6ZzbMjoM1Φӣ[H"9h[YKSPƠ`Z%^=l@7 iwmG&nxCJ<*Cǣ~k-KP>{믷@5Es`@ͥZv2MP95 i lUwllmL%M OMH,'{ (b\:7NH:ITYRl`Y %d8b*\S}5D\4E4#FdnI+|C: Pf0oA+鏄X6qn%*g nt Sֹ~ozV2W$Ǎj)"2'%t^U!xiКuWf2q_%,1UE!ᡱ.=[ɢEܼSx.8MF᱐zIrAE8QM\t4njJ L`IxMUYO5>Mjwp7UuSYנO# P'Eb R˝MЩH$x)`^vТ^e\c*cN2YiHGy]њ-'O>rs/zw-t3D!;;HzDO'R=&dBH:$!-c2Iz=o&UKmi؍|=+⢷ ~NU,a4]9N/[F IL!RQyc)ཁ-M  {OA28FSEe pj?=T/`ks_rE y\ZQ! T5D0b:=9Uw>fǥ3)Rw/7[pB[w%jR)uwHhFՉtZ({c_{ KeːNj2И=V;d]Z1S/n9q/.K< u7OBr4ME .xo *@yhFl/h,=Z::I,g7|D17GBR! &(}VPٿa)$?xb$94ꍨF 3b/̢..BSaf~;]*ݹE**/;r.-)]̊Yj5qun0YH/|7Cm2 C}QϿs|c f-&Iia#ٿEU ̓Wo6E7U4޶dV-W&!ʏ+)ͬ`"LI @+(1.i:P/_eUFȐIg/âMcF.>~ަZ!2u׿o]qz3ωEG,ryw$r x5ppu' #nPϓ@4n #a!#-_\Ol(IsСsBx[F'C6(AǬ8zLY2<IvFx+C kO-6ڃQE ]ô_.j&*׀NЉRH2 7V IEA<#~][=ǣX[5-@4]DaνKa91-n߭Pndqx4Kg* OB0KH.t5O+4x˔2NHbkuo76@CXQRR3?("p=ەY?2yA̕OWewg˾v-t`ShѨ&qIoKBSXK׶W~ aݱEfX@U^&FQ`ٵgAo\B/?uJʇbФ`Sg mňvKr&$_I9i*@ø AFyɫ` W #R)>j_ %.P Rc;]xNK >}92"G/xY(<GR,9ZKdO/>%繣Rm6> @fqRAgFׇ]2Ȟ_rvN+ÐKRJj+*kk++kY-);xF4kSLde&)HSLboH;{_=b/)Nj92"'2(4{p~}{|.`2ҴE۷"nQuq<0 RH⩀Is'r?6Ly)g#<$ =  >̄bnrYQYxhJ2!2_^D*Ds csbql!?MXFweh2,[L8KzY 5ە_BsѠ** ,r eX";VH7Z]:{jۓ7_zfr<]!u7ș7a' v0IO[Cq/j('O Ƞ}( k%ƾt~][/m2O]XHch5)WL$|pߥݍ!eKҊ׵LĽ6bEwB-6n)Xxhi+-ɢ #'_}BVyo#};,%aR>,ӷP(AXz w\̋/^<|ysV#&!AX>H<څq}U='E%BTl%pZ,8%$Ne(-?CawBvIr1xXH&g'hYW ҉S JNP=!nHNϷ}?laADsC6enSeꮦ߂< QK+vuF? Z_qh$H웴=~WR2"T %Mb3mqC^KUdgb UlǧfÇf[a/3-Ⱬ4^&>&1?r< ]ykxsBw7r IeS%6Eyn#|%^PF;Pܪ{2%6CÛuVJRBJL/B(r~^f-)2[yak8 NU<

a%ّ ]A|!ٿ# j/u{޽t%25޽- MVMH݇}Cendstream endobj 433 0 obj << /Filter /FlateDecode /Length 258 >> stream x]1n0 EwB7eZ%C> stream xUyPw{UDĞ(z Qr9 <`DDeDFQY5庖fKt7)mTmuUW}?^(L&fm`L6z/}!CG6B(w߯Slm#怚ʞd[BG'͙3Kz/V֩ի{"c##*u1a3&Z;4\o:fzSVup`: p}__E/ݽgy|pbLQ`ʏZF-(G(%5rS䓲ٍA#ʿ7m"JE(mCW1v塱!;ef0"D8#ތקr|M8WE``T*.7b^C'ǘ$)4آ(fHRvΙ׉6[l[ȧ9 s !*rsAGnE^˘{hRDnMnnn;K_qB>fwRVBgr[ɐȒ+W|ћԂ:`^Rݡ|H *KE89{\U8͢Xِ8)n3ϫʃ4`A"2& HNtG1piAo@Td(9(`PHk%8s#+/k21v=R24qڟ<= l)i?$uu-Q?^&!H;sR>uP ,F2/!ݡ;RZZΟJ1'KZ *}ئQE0 Ĝ ĝ2g'B<*AE#NϜ랶 HἪK&)Etơ|i@'G'g.Vx%xLE'0(0յ5GkYN/&__JEƁ6ŅDޞ җu"X2G7 8a.:8s8RYY:c~z˔+PVc0TMIٮ%y,% aϳB֬dZ-KNr>P1H{B<'NJ9[ҼפEAOߠý/5YHY&bVRA eb88eCn6ETH6Ys*0L {$xM8U3W#V~6$gNA4Zh:rAm+2SB&1^knImh=wR:on[}"4Dc\q)=|qFhmw|*/Tĉ9WǕJ~N[ >7%џ^%zZp-ʹt#qW7Yg9L]9+uFLߪ)q[N}:],GuEԆn;<0`Oa(mgHvi%lP!.fc  2ba / w* xK1téhߚ,w A8ٙoW"+quK/Fr//ю.o"KڟhwA Z DDs+O4i,}}tFǴ7ޚDOHgK:Vϣ{+?*=`ǖ`+ Q;m$ Z A.$ ӊӊe'f@=,*,/+H ӺĔ$]LbL_j|7=Pm+ǗC!ߵK'%OV,2SJ78M0߳ eoH8k AXaԱ *b$ :v Ky2rMY/7g_F`2 F!=e)v$؎>m2gn %+KM%&1_@-aendstream endobj 435 0 obj << /Filter /FlateDecode /Length 591 >> stream x]=nP{7ɷ? i\$\" Y.ř)Hb>o{q̿ڽ[rkoܺS{9oa|Hzίu6]?h#^Keioini{ic]ۖfROUqq~80~P5qgƥjV5qD>pF5X5#cD"DcA F &#!"/B(D(S N    DgD#S+c+C#S+c+C#S+c+C#S+c+C#S+S+8'F(7i7j7(7i7j7(7i7j7(7i7jw(wiwjwxVu:X]N^`u:y[C[C[C[C[C[CCa1d2h2`1d2h2`1d2h2`1d2h2`1d2h2`1d2h2`1d2h2`1d2h2`1d2h2a1e2i2M&XSIk7ɛ`M&y)$o5śMx o7M&XSIޕē*n}n~vי9o%^| 1> stream xz tTU E (XRyAeQ"@ 2R\TB@B!@0+ Z>$(z++YMݪs}{C B<ƭI ̟.=4>6{q:7a$/!(ߏ&=cP'(:yURrvjltL/;\:1,{yׇ%b'&FL\?o㼉DbęI"cB&&EM 9q6&}Y~(EʤUɫSS_I[6c]zQ膬W7Dl %fkqw$̘9oœyOfg-^'(j2@M6SS-4j+5F͠vjz fS;jKVS=?4 5ZC=CP먅zYj*H-6Q45AݦT5zzKxʏRSO^!R5>8$hM^PӾY|4,^F^3"pě#_;o#-ÏJ%?6q~Se'>y섲'_y$]/&.Le'N02SM7}3;ԬyCNvs{E><5 &eФmRN( m78,h;󾢴YdL+Զm-rFjM#_K(Ɲ->ES PJAaɳ/))`+OwKڽtO@Qm h¥Ț`)2\z 7е(k4be|ZҫA+s+ l6=kqY,.aI058z=ᑒpV͇Lz_};-h! ?7o!/x(I^@ ާol}|/pء]9Zi$,~CR!,&ahl<\i`?EdrA35eS?̏j*0X̿c}.ϏC\Gy|Y0xK?E#!dL H (Zk:ö]8x6rDe=s>y`3 9(Aϼ"ږ] a8gWȂN+d,7F L:+y_@z{s#|D$NIi^-s\ndV ![j^P(4,~y`0J FY٤O*D_~XB<pc;+CNGT[nd(|B C$F5-udՖy 17y!ĥآLMv1QpA+^d,8rs4b`R+ ͎`Лe^fWS E,_F3wW+i,m:Ѣ/w|Y4 $zF//s$Yp>Pu6y(ANˬ9j tZz^tɏa;ljI1s]$ ҢMonwyx *bb`k"~@ˀԏ\o5k$zy ALӨ7]-5Lfxq͙wEùx[~%NRr \(:{Zgol&eŅ.qaဳ=^ :;xQL&يILR{%;ݢ3?al .<R biMIGeE'K:y8vCh7"~qX:W`WՉֹ-_d q5Aw^S}"·|&ڐgs/~U4oZvChƢLB:ސ9X_&D+nэwc7YV4kM\K步L4ޭh2N/_*d-C\GvE-J. DMƏ[c V/521<`3OŢ}KWI Fu[ 렔;qն׿? dxt7 bXNF+shrޞztj%zTWK!{bDHۆ{ s@~3?^y>H9,~Ze;}q:T֛=W(*dlob7[;GRJCը0\\;c(K@X xRߥ_~v~O^vPyo:&{מ&r$E6{UM}==8hR*Ry*fVZ /Ȫ+ͩ&D"d(ߦjiJ(W͹ĽBnNL,Kbm{V-w6Wme婥,oϠ?/dhAokApW`i;.TbmIZczdz`85{JgM)u kj0ЦBC`%2RtkHE^:2 :a22?s|,Rd%ߑN2?TFgI%yi6 Вi8c9ųND^2YtX p`@ ]&^Gwzs?hxqYn4*O-thN8YX%[DR^Q*bA ,R|*iWv85U|$NuFT~/+$&<}vԒ4ҚVE{-<ϓ5 n~An3. /zƢ'  ʝ/&bWVAXUT787dʆ .nxIxU|N+/]a$ OC0<OZtl͓G: yTIJ!*⊊+R%mٷޛU0bDLئ夼soDë5g-w,VZTԠ1. p[<:RǤJXH+}@@k_TkV(t z݉2a~nI*CF59kh؅;_=GXܷ['#(KMǺk) +d7=${mLLB<:,g}e2GnEUQA+؎cySeӑK*EzڅNrȧ<_ l:TWim quMZTm*8sxg9|K# . tU?gT(SUmd+۫@=sŅK3s(4oOHܕ|rn6cT}O0w,cѣg>~ֿf(1y6ɐBb-j.jc/ d##kY-N%RYl’H aāSwSff:.FPJ(lhjr71nz*GJ AٙҔ3ͩϲ;ؒ&?y֯YWj2)~Gmo6ʌ>{XkGo2kպT%SvmYS̀hz ^~Ֆ:8E_g>:oHpNגBeXmcq6m{ h><83s89 qZ7`2BX‘m3w{qO1#{`9OWVP 9]4$J%QbNLIOݼYAb^6Nh &+Seok`kG d6CA14 nWF哆?ג/_Hz`UMp=g'N9䲹|1dR55zk"n % K!h*71}Z9v1Y╤;:YW]Ym7XXK׽.s:w {Ju (6W}y{mvKXf:8& '5F$צ [VBURۺ\N^|L>H6RP>W-*+w0KIY֚ 0H|М:0+  M8 CJR\l04& {O~Cxa]5kl)&leo.˿ݓVHDQhlrR"1壆S~ 7z`5H;`N7Eh1mM|y&^'%3s}| r '" Bەe3[h}G'^hq0?OZd}ҏ %q[Y4[wm3bbGzyBg}>CVI{Ff_;qNh::{hr+ BCo?W&/)meP%K\?aJyNmމ+;<ϓ(p; 67*BB~!/[M%*[XŁ3\? \qhN;ZjZB*X@foDӮ0 2t\HD[om7ϸZ2g gȇ{{.f|) @<0qOf*J1/NW&j^ȡ0cDEBАQa[ud`mޡ:Dr)oB.i"֮$G<Ȉ=.G>" -?\׋!G?~4C`U'W;u@,$mfOB>Uz} W&16ŧ[Mn1r}]<z~{|CBC0et*~~3Z(ڊ{2mb.]Mǂ* qVJTuއ[iʾҵ DJon4=\@7|'YA&Tˣ7̹Ֆ /9=#ngZNSstk{΀V/ne ';k4;]+?P[qV9Qw8;140pߨ0jd0{FmbE-0|endstream endobj 437 0 obj << /Filter /FlateDecode /Length 323 >> stream x]=n0 wB70* .钡EL"3}dϒL)O[(9})^ۚ4{Ů ÔyM~)k|,A;-?ںO4z]k舤G)4*8N$ +&*&q T`ӊ4hxZ5(. Rum%."ԢF\D@x2 hl܋ "{@T ~ k0±d kqEW03o4辨6@ld6C_-bTBkendstream endobj 438 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3955 >> stream xWi|S?ih<@Y# 9"LQ ^(,ԲXRJil]ONfoӄ ]B"RPdӺW"(^ySOyCq~:wf>̇9}p)IÙi\IIn(ô5UW9pܟ:Ƿ'C RAFYl6p^)mPTT*D$/]<=HݯH}~Iܼ Yu(5O j#V}Hv,`ilfm.VA/-F̤a&5]F2SgǀL"!zfvUFh{|6W"9{@8d=8 X Lk-U TA/x3/6[c-T*`v9o1<7P0DFTm*rg;No7QVY Ԑh54xb߱gYAœ}PijΪa)<Ŧ?ꈱ ZT\&ݛ9w=9f=޳Fݜo4:t 3H(6՞Uỹ! ]`f@ޫ)`E@>E+~@ogX2l #LvKlgY.jureBO4g"-OU{H'aG !g1#6鳅i!/&8>:QQR7ӈŻ~c [2B{a 7ŢB(~h3'ͤ-/$&eUe(M ATX%QTkPc#HGQ-QB'Sfv^/(@j،e@B=Shr!B(h!P;)JIu|5ZR+v* ȥ׊> TC>4Nc6&4 nܛ(v1 ŤPũK̯b ѽW{ **&k}hOѳAE;$*vo9 2Y~UV0tWz i_.U/dSE9` HmALݎw]Y$ljN G~Ht?>ܨZzJXcKm͏$ȮI>i6mI>ANJo*vD`RݤrR-t< 6p>vz͍qSƕ 0H&괔Ũ+5)d+{}k70K=4p2V >\2.;wJ4b{P {/] :D5ڕC,*(φzkW6C~0]Hkw*|Dɇp;)9iA^X-D($wy y Ӏ '+k/ccY?O_$bfˌ<9.&OY4B2{p~a>^ z:Ӧ@ mN?.lXB|x ]01K׽-c]Ok(G8uNS@o$_ .i(P`iwwuAzzEkvKkTMu!yL)runx'ܘGa}Lwp`Sk˞[_ yfuuzm!iKm'ߞGs:'&}7VSRnTdie!=0'fCݣZY Fh 1M2˶@y^ Tv676>r(+> }50T2*Rl_[7YtG\`5A\3QP07]FbUi,T@NYtu̙c] $ rGf,Ohg?_#ѣ7y\ODMo8z>zADRh"*Bը]ҊL[/H0D>BSw8+>b+8q} 9o+›-Q-6gOf6)(Ԭf!_a*oxX o9iCS򚂽C8zH s)fGј:/#|y.'j:̤"Ǥ):RҢ wF$&i8vsϋშ|xG2tڽac".ш3Wh-zlUSJ,G];zh&Ȅ!~E;\=“iOS"H|-@{hP6.isWQK2ekQ Bs,R ,aw諣\40̏7K*+ŕ5<_LM/eݙ|]Ez'0; bsLnzfRԤu,YO#n()4^zE5_Kpy~[7 .,\IdXGG{^;#vr$o;?nɋol1JjN*vwVF٬WVK9=m *M ~k~e%Y9@|!GL;BZ^I_wKOOW_840V2fm>ng=`ފl5 ?/ < '7ݎe$b<~@]mOkadXTnq4lWG@j$k|VbզnG?mjs8&y%Y9; )k[ZuY`׋Jq$keGP5d&]s٩W Z bI"ݮ77{` _d<Z[mRcr;G sG.6n-/./olmLԋĿw|>S嚈" ?F'>Gmx :#r}8~ <Ȑ>G<9ΉQPh3jVuz:em^o4Vh}v<8v_8Y?ZA\c_/UUTFćKƆƴhKq10D3 Ƿ~@Dϒv+q 7>x-d{W& .7{[f%MAFva=-D#Y Zh-5}oB@)Q*Z r; vc6dh4J砛q[ (=ElL8.굏' yW]wדf]}hOO8& P2M*"oЄrA1 s$ЛH˕?<[KAr~!!t&`sGB]]yu?@g43RzfM4 (/:mt:5mʶm9)S!ez9hkz1.!2 endstream endobj 439 0 obj << /Filter /FlateDecode /Length 344 >> stream x]Mn@ cf&"oMgX!޾Ϗ.H2[^s|~Mv)oumij5KV_{I9~Ho-?U{R74]Z隲SYi4KS/{F;<=.i lr @W)U8C x4l@ SYX)qJ(Z)`mzàLJT  aPhR̤ФIAI^)`xFE="QoWv} h(Xܤ0#DV*bӈ6IDN#4"ny#׳My.F=5M׉b[2Noy~endstream endobj 440 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3504 >> stream xV TW֮f*Qtj$jK".#QLTdS}}lfow) 6A 2-I4.+|d Mr2̜w;{u! .1Q6]C"'V, n.`vlp,GtHopƔ(; NAS }`Kh\dUL$>,$4r2@b`e`DLJBDt'V,7Ƥac-C#[lt jZ'Msf,lJs 'bft\|e+f|fE?hID@x'Fbb9aDF4!"&L 3B0'  BO>::jP= a3҃LͤvM3)`5ÕFzFuP:h9}TmtFP)µ%@<(Qȕ[Ȩ s@ ?7|Yԟ/;*Vl h8;lK7-h?TpJSZUܤ7D؂#{}76i;z+RAlVe*H/,LiٙVx TPbUU;]%1!O/eʜ<(}NO \<7&oIU6.ͫꖶzϬLZh9O ]}<8>P݀!-aJRNd34IVkWIgK!"+)N~Hz↌?^o8 r/(kh %θ}ǜw=~@A9#`DTZd/4æu.1KҧD]ؙי:aۡpœ6s㞉&6E6_׬Ikh O|R3nۗI X??En l_[/ug,jIhNHnLhiillaXΖ«ظ؎bV L\UV 1S\(9W,+.|QHL"y7;v@3PRRjJ(:1ެ3? s'[}O`IӺ['T5x2@΀r84*6k1يu.r<Sn} "߭4|/bEp]&!}'4e^e|9Jďg ^'Tl:"Yɮ_ sT ] `ռn2Eeu}5Q7K: h 8 7@V& ))jmd K;v7P+;Xh{\{|g>e@/$Z5Fu9?tE7 n^~h[N``,"-U#kjI`y.Q>4!g< "/wj %wJXOԞq}6wd# . 1kƫy )lgoC7?nCk5/iM^<~LW;r |rA9 _34O͑6,pI[ 9pa4P>[j+/2n7J&P)_5du.VE OJ-:uˀnmpeP='l |QaxE"0ry ȦP\;XgWs&T^U#.:!"uH{μFMrI NYJbʳ:5ы]a65 `gf5z. OP<>~^tULHdovGOASV4苂qۆsl4&WM8" ܶI|D =g9]?9XRMJJ r 6ep_$lBo<"I:a&$sv8 ma5>ME뽧m>ߋ~> дQ4c3;us! <Dm"LV"a!,F>P& +@}k}.Li[P4Jl#]gȡ\0ȘDŽG ;Ï/prTOwu%pwKKJSD.pMN"kA-W2٢'4NP&ujȡK=#!1@zxXg.Yӷ9ճҕ? 򲂪܆ 6>] iJB.F~x>t%!/=| [Ůe#l` B ܪ]^j F =77_I`dV*TbizU ˲%EF _cOendstream endobj 441 0 obj << /Filter /FlateDecode /Length 4393 >> stream x[KwFkjBF9.9D#)E|LSAB8~IKdPGeJ/zqP>pQtたxJ#m>ZΚFIYZZ^:V&SUTLEYJcpZ #,dUک ¿ ~eh824ݮoUS/iv*Q↭^2%sI=`?J1Kr ^;c|VtdP:!9N\SU< |x7 ,ŻI?3JFV3cW27ҼppWkR:ٕc֦wx7e Zqvpuq TҎC+څ 'buԫ[;PhU+<7 PE. +um/YLQ,>nnqTTO;eh3hioW͢7}oƮ!(iBˬ؋OzVf*JWpTBWAhApCVsV5Jn>ZR EnQ =?;Yfɔ $ |12ъ!a'iMnΤ#> N,{JNGgqr1Xo\,{̊מ3ZeIW2jȱҽy ^U5ȥt߰}T^ԫpechWTR?܁5[_-<4y0O{uw/*;Ф~(߬_?5.o8#$ݎU`,0`LhFXp˽a1Cdg S٧Y0pv54+kmjޕ/_{TwޮIVnV ؂pg="_ڝHn8Hܤwtg-1rS #$p9r |s)BLŚ_.҉:AYh\~ƅITU+ *MfӋ)#xwϮWEϟysuy+q$ְ4%Kw# Wf0Kz_y}B TE/ ;GG *%\SY>י׿(gxX"A6Ԟ &x^[z[pW}6*[F-A 8w,C0E' GL<5|[>f10:+@ܯ'?j!G]vW_/?m aP=˝>^d $Z1`,? W?2%o]K@ d)?4cu!bcto3r⚞wV{>h=D^4\ʶ3 zBEOom Q>͐/0vib@%n Vŵ+y)J!ujV\aY BNcXbnRqΣ#i觫5G흦kq{i>9{X$pqF{)02U/Z-3)p0Rɠ-:!(b͕{:g:nFB+)x#x9wbRD4mIk9Jz;fDt( kǁcUgp5>ˠOYE<@T%ˬ04 mrI =K tƈo̯fi=Ī.*g/=aԈtqp̔ \IB&89!V`Z=}3o@g޶ɏsٓSܧ ZB͓Q{僤2II.;)ɴu'[F+w*qHOc=%B%ίnԔqV&lU m؇լP,=&^jp*)[z{?{WAΞp_-Mn` 0YSpĆf&11;o& 3BEW!}/Q>@L4 j漺I4=#;(ARAM8i-3+Y8iE`Q@2տ@`$`K냦GyL@izD8@-@8 Zu7K1'^"KޞPǯ(wdW[hcD){YyS#QCF;-ܚ‚|ɢahzSB,U: Tɓ BJ~,ǁsl|׬!,-a)Ao1 דjEehIn8aslRzVD:s.- UR-?]>?$ [<.%{9fQ T MqEs(0f>HqgůH"O*lO\݇wa8ZYzhXWCNAu;H J>8ݬza>n eIJӖ~_khA?[N|C fCIIguF/mJR %2X6~-1G49p T_,!rb:$>.R3Z[U *\':M]ۄ!^H7zYzR\g/0޶ζ.Kil5 (nk;͆7鸦 5cWi2U&zb\'Bۇ[.tO>ףxCXFI x $gvֵp0vku_vϤ;jxA(WhNY~z0]}CՓ8:f]GݨMVؾܐl[JXK|V Vz*gI5!MvsU$I-f;goa:Rhvt!@v`yA&?ZU׻HEM|PbòC17:P'[TOnmLqyx1j> stream x[KsDxx6Ņ0ʁY-RvRVh`\+)UIX`oiSvv8wVG;/k|i/.wl}jI5:jlD .;W4M,YV j2R$E.4<-XfdR?y*]Lʦ2Kr➸a'#EQ|$0!jʛ`v*jf-$ 6n"g:1wf[r1ReYmU+~65BYhML,4+k+Shv4޲ ž=|{-$ 'Y9r2>GS.KzO10 qeB8M q>"pE(j>re(^ZlL+o'|+2* +U[+Rmr={.e֗hmS~Qr6J cp<>'x 4@=o_\BMVÚB@hv+g ^NְE4׾ų/`&OTQmWLdɁoUDSsvfMe j\@}8,RބfYi&HQz3<Ѧ 66Qh c2wom?R2CHӜd k'PSjӢs6ެB[Ff~MP*k{V>YRS1)W=9^m/2dgeTo ,YȡcJD!4~& dk=g+F3Lò\^Oʶt_a.j V'JL6\׫roE`!/&ZDMYB&F6 (U6D DR PȰyPBA׀./h[F(#Z.kDl4#K?zj7u- Nc$tdt%/!r%PUi E/mWbⷌ gP`-/i`5b6@6B5)X7)1E)#2,5zW0r4H1iY @7<R̟H0کWnkZJiїج¸vJm u61CTf|{*A{k6%Z*"L܀a_k@}2Z8 Vt9;ƶCh>co>{h騪+56¤IVk:w~_@ [gyq{hkgb6CC 5i΀G<%k$IaH _S.?F߹ &>l| b-LFzY2=%ʘn|Rk 4nZ`ΰuJNM+ B;>-Wt=zm{d4f@,Lb bDùqLl)}p1 YPjI;2pTp?e{0œM& >qL|la N /'3oDw{t~@RҔ+AA02$?RL4ѪeĨ펊`. z%0! N"mI/pXuع̕W]Q+1e^~""o] (<E0|A! ] 93'@VVbކc$0Kt71PC() 8sysN l^m< V11x Vz3**sI`7 A d)bH=ZO;=H ) Ώ;)EtgȹP(rD2d)俰붽ۋ%H7Mb&us⦜^Νe :QwZ}r%(9Y4:k쾯,"sעt{A$F$ƿAa2a 6/)nd@j1b4"=0'd GZ٢P pM%>*/xfD29xBf<> "/{ 4]*!'ve +0 cm^F&< ݒ2\Ql-hI#midlsc).t6ZMې̭oW&)`!]U"T_zp<9M9Y׋H)WܐL@DJ3-yF+TnnC{u! o+n͚cKa邕[źakk7zv]G| f mP:q NFߠngjJ.CkDLv8!Kma*PǸ9mNj7#pVan VCN=X׆y4{9īT5A< I{1{i"}ց=t!E 6AIOɪᔑI;@m7XLku3@m\f[WY<-ƪ`JmȺ뚢B &xHJG f$A1(O2)q(3=eQN}΋}ĪIKI_7p6e.YyƕEUJWdrʥTAb醺Py)9!EY MRtk=67> VW-6>Kz&%Vn"y`['}>lEwGܴq9Y- /-w9{ X4j1!׫Hӻ+ BRQe;@=Vo{MW#AZ"S9Ez]MOz{rpr m W8&@wr'3@d?l0cۛ%Da DmNܢ xn8NˮTEq=6op%" S)QHR.ە}Öi'x{:TH uW=O^WqqUpۈY+.[7wDFbR.5{j6tr075;D:~9DI+[/h|3IlxbS :Xx(Cj/J[} *eDX(o,LHstS_ږ[%lu$Rb/^cozJka+$v% i wQ?)PܺleIt z$&oM3FE)!haƅu\ {u? Krx.{^suE-Yy{n9g;P14ԓ;eGtC]a{GJ [=Z7\[D&H^ Ud aH1Sl_ vzXwW*hg ܳ~Ϲ!d%T'}endstream endobj 443 0 obj << /Filter /FlateDecode /Length 3300 >> stream xZKsxKpJ)b9QUL,ˢ$p*+5IkXjwi>gy3 z8.؝G_#Z]?`(w=O5),l4{w໰QFF 5-иYcËk0<|y5Ђ$}_SYYz<֒ܽQK66-5~4#ˤU6K;*&ѲPEeLQ*exf%v\'R2xȃoakY3yͯ"eWLH>|~;1(vw(P2"e?JLHv(u mA{7]F@;9GB`4Lx_;>v Dx:e694W%J' "j` ߣh87^NUǏ>1ASw[Z9USn1B BӍnRZkE⦺ڍ>$(Sʒ/!oB Mۆ]ʸسjMgE9b| Ntv-K8)(] *} :"(И~G}U1Rq۶/ tǏ6v|r,AJjasTWs˄ rAс#HV9yuz6ӌ_E56N|@NX%KtwSbj49qM۞~WnQ$r&@Uj 6,Q_.s#GJŰ,nΝQ'MVXLU{jxoK(/0) ,x6L'.0פ<;?g.(uP2xV4TrYzu{ta^6iNȄV0y:3]8ybReP>("X]iDjb~Z~ޮ@ a\*Hh!P33ʵs"+PD];:K>AWD(h̏ `M:mPp;km^!&+8@Z:6YX(.nqg674k^2iEB٧4H.qOBQ~\hdE}#> ؾv ׊d{2r;0j `&Ɏt߯ila5 wzbv8 bؑ/{RaaGMɑWsPh\LCj @ռ $¶ud66gͪYoPss] IO1tqw%[k"$[CZ̧y[HSw&*Oܘ8޾5廅/a"' r|xe(H$U ~a4$*0O+ ;K-:;7`uw^!3t6$tK'2-/3rv)nZo,Bltx_`f ?tiʀ+[rz`(hW\y~===7H|z Qt*9-n1en,OY͕`/ ptL˃! LB]z2s-jeJ)Ij#?Dg[3ۗ#zVKCDB(rpMzCt^qw^+G܏(4{;9uVS@_Rj!I_4޻EPMQ9hQ0 ?ڪn If"zq&COUx(2N1w((fWsp`wgZKvL8ӗ7}lP=N>5.w4cGRוMe7I&52}o ޹N"YM3aK5 հhj>,>۾ ;5ԢKG/:3cPE[&eQt(CNsrAryնY(gy7wm_6?EQo#\-:Z̋h~5y9endstream endobj 444 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3140 >> stream xW Tg-Q);tM;>\bf)D !* nZzowB fྀ&&1L/q2HKL22s^:u_wo?F$lH)\0t",\?+GcO k0vM҉0vdYWRQpEO?MKCJBB'&-޽+341'%t}ưMffܜФԌDEZhnZԗBc_]9fK?eF`HeSR7gdnۥ0f&lcf31f;c0a L3d1f#3)*Lc='rk98R< 1fژv= c}9~YL>7W`{`x!ճ rl^^Քs`+CLBd2CS|*N>Ʃ!x%HPCIns7z]0hRH~N!bqmŷC8kDT?b;ngːɮNxss8Jg3r6\}QzFP|tKL QkEfDDs8=oz2-7MK6&] PڰJM<7f [ȢLIQN&%AoNdi" |…zWz'K] b# NqɟsiA4xG\$a#;l4*]> ^ge`gnSw2N:JI]ߛG?zo:iM M&߻TzZ3du$A YͨmQvkQRbr`@EM~*Xe(QPj+L-N3Km'r(kk .[[/ƽPquuOk IREqlSJKM>47F gH(d.1eK_ 7(e7%"2KU/Waje6hTC{(DsF#NO!\h5nɊ{5rYmڏ?HnXJ}< !I?V`}}^+|G?נ:'ACxs}U՞3payՄ>"{[.0VỗddmBj5ty{cgkd),3洵M?~B|-XjlI2ǀ="q\nLBq!\{~/d#9Eaoj[ Mv9EDZDQaPz[ɸQ*5+JYny%u2AJ_]=9:R6<2ۅmˇ׬5>sTːqhOL05쒸AMm[,L ɯFfAp'TRӛsȫRA6\hԉ_I{0Lg 5@"3$)z2#FcgKI3߁['8o瀲5 BHR FyE0tZܵv\C! gBWqڝI,7NK0XQ妫S]Eee:=xCir6@j0HvX7rW&yhL d8Г{+?i-z FVRW F.’턑󴻊 *Uyɴ5g[K  v[u_]GEBRM/ρYyqJ}'k[: @b..WՐb6+YMN~Zmntg\yJq E?>0[׊@Y/#AvN>/#~'eC& tyC$lSn^ߊ1Ԏb$m兣&KR'*wQEV:/vu\:zڥVS9#T]|:TDŽSe>dt=,N=I8 7[:s;8>ʑUAq0kc=cpw[C_; s zIrR]fnm\HMriQWWhsXLdz r'GMw>|' %k aDח$cr| xH1YY1?pM˥G! ^h}ߥn[5A_]e[ĉc ۻ sjmngim ]&d6fֆ6V#f 0MIendstream endobj 445 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 !b C+qP(/ СY:ߝ|pME u:귈ֱJNV&.*0Uxn sZ?ZUukZBZ!֘l@ )Rr4nn1Kii XGg9;3pS>endstream endobj 446 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 283 >> stream xcd`ab`dd M34 JM/I,f!Cܬ<<,7 }_1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C50\``````(a`bdd?3qG߷0~բxy؜u̙[r| 87mBU\XBBy8yL;ódKމ}}}&201g>endstream endobj 447 0 obj << /Filter /FlateDecode /Length 182 >> stream x]= wN ӴKVU c""d Nҡóa?\u&0rm 5'cYUse DfYߤ<4z㻜x =U K 턬+Ki-Zj6èS+HՕH())#R:# R†k?9HgQX].ľİ_> stream xuL[Um{(6a>ڧs"F~ 0Z<(`_ܶ@  1#Q\øđ,nnYbX2cb\dۂDx9ss9iEE`dw5:ܮsK5MNwvRaAHI+W7;ȵǙNy:\Ín먩Ărs}hQGM:SYzŬؖ2xYG_rj;c嵡H Lɸ;BQJ3%,sd_$I9#N2%c]r?fvD`cӗ&ao^5ԹZٶ=}r=9 \|*CaUp ǫc2Y_odO^,Ti$P++,u}T6#aγ !U m=Fy 87%c {s X6Nc*^ z[K5Lklciӓ@w*S'()# ë9<;IjLѕɠO F>gFF">a8k[endstream endobj 449 0 obj << /Filter /FlateDecode /Length 620 >> stream x]=n@^ Diߏ ؍A PPa"NKGeܺ:jn,ޯغs{,ñ.39 nmXY[/om=Guj0mX^4uז鿏28ϟ_=DzP5jjόc S Nj\5(z*h{<Ux`D%KhUh^5Uq"`!W,jFXk[`-z (2hL"Ƞ1"$2 (2hL"Ƞ1"$2 (2hL"1ȸ#~L;2ȡq"%r)rh\"ȡq"%r)rh\"qcwd /0#{C> stream xYTT־#pgTl\c=Pm pTĆe8֧1(FƗZ%/!k=s>{>#GQ`$@va~7gSQ;Zp$譕BM7M `;=%%ޞ^Ƌ-Z`y]iiluDmjBc[m[<>emo5kgyd׼{,t`/]lG+\EQө- =j+5fQlʁCmާSs)GjeFS ('jESP"j#!ZLYRK(+j)ZFYS)#ʖZAMޡ8JDPRk(]jOML)5ңj2BJ2 )-ʈJِPT, "Fզ%Вhv־6 ? efFw<}XWiqx\и[㗌/_&NҝtB@")51*5z2u#̧ռ3$N=׈|"ߕ aKآŧ4(.7%; <1H<,C(%q2RSRPȿ Uro.E_t`9]?CSP ]لx-`BG3z?*AϜ `͹@ k69{GDp`\*}.##XBՕ9ʹ{2K U;YbTj)v]_U}9'ckq8!FT!njA3sCf|-r3Lki'K9@8p4mr9ܗ .)Q{ X{< 3?̇Q0ꇗY mLLMm=[Y-r@.8+dX A( K~U-Z̅Ue쨬6$D5b +PdjBr*~فD%Va+_*-r@7:c4>Fi?9ϛc^!T-5Tnt$?#2|ד3!w^6[ʩG "獄 ,,]s!݆V/ FFdyư,GoH44bC,8]/ڇB0_Qr[ݚwg b.qV}1 .oT|1?sZg7\g>Ex}Inn_*\Y}<ꪹϢ8.4 vHK"on`4m2?bu0Cr@Z >Dz5qVi2U+Qɾ}FFPF+bXK^\y ̐Ji#T4nQ4r\->Oa 4bFܨ|`Fek8b8nˡJŻ$Z܍%9KQSG_esQYQPCYr:R"HWרg2qOX]h}`.@q)%+Fm]%\_\pXMɐ̶qx3qXiv$Z1P0<׃C1U)ΊʋkcΆ{p^m][ acm50$U Q ܐ 1_Lzl2lBh:(DX!v=^Fʥjm$yy72hG8ӣ(B[D Gt;Xa˭7߼c0K*3_ w5ː$|Z@dQ~)+7K2iH+hBm%ه|^pd?dYdRZD2c[ ϢYu'<7O3]xϳO 0tٝ+o"Ү'n zLY8ނmMx > X51΢E6hCxh ,,z.>tTGL,w(M, &VX/WW, ?Ya&΂>O@m܁5-Zi*K'G MOáM;?Xa ;O۾b.F3x>}[SCG{U`>bF@G'!8:Mxedk߷cj"?Z!I(%eŠW&bǗe!#US~8ݹ/f֨ڒ̼"$/iMXsqqz<\ϽtĹ vo˜u1;{U5\cE!D5"T<)@Ŝ.+FȰ.DyOIKOTUu~w}N,2Yݥ] 32HO"QDjfZvb_C$mIx@P/_tb]3ԏZ wh n U9b__ _; /wnEXKȐliF=$QAb=Z++1ZmǏoBmC"b~ GaF WVDBq/y"n=ܦg'>5Lw_k3b%d5ROqirF-;Ex:_ǶI$aaI]XKK]]޹V +ܯ3~b5cqnGV2p-qDEg{܂1 ┚@WF'qnJ gkY!b0-)_K9d)y|XFUFeF` T=V]^YG!w_}'0yg9jr1LI0e`{W(.+&,/j  ďB0Sн13$uBS5Z۩Rh6R σQT%Y5Ɏ%$ vګ`h>l 3j(1/uW9V#g@I3J PnmƠxA0 ,av$-xk]M~~mA۹\g[RnsIJI%hQLyTe ({U`i8UGD'e$8KLMB,JﰻAYbv/+KfG7|vzJ-@^^Q~K|ڝ>(ÿq>Y.LiKkk =|"BkB3S"֯#NJMH%爬5=9$6'DCa9D[Ⱨ>ɝ7gOܚ)>UhpE0vS϶1 AiRLqrnV`A9^Fl,S$$QRoʡN~ DK>d[$(!* %$p^ބ@tx7j9`[/NRh2\u10 oHOTF 7ZƮrۻoN]΀ӒIN{//Ì 7 G_tz)c6f% y <]Gթt쎎;*`v4엑x\tenZ4=3|pk4H!o#ޢ4e95trlogU1Ұo #ˣjK8E~E&BO7*L[}YZ0:EbLGHXv&QX{ 7XFk0+΢sk` ́YWw|0^*T`iYWJmʹ/wHOGQpUjyuwEjw.ȍ4ޯm#$NWξwyyk@w=<YrGK|em}eKIjib>W~tE$ztsbmRRP3 E<^YIwKi?Q#&`Ƣ[X~r ]5 . FYròlg1^abߠtt1NLѫ[/ڷt8774а?n%CgUjيԔd_-#"0$TZ$:4J"Eyy\[KSE*"Z44&jF-5uj;$vw{$.u¯oNBԌX)$Ƣt^>bFC|o ~Qc`ፎڷrX&nŪ_}|P)IxQˆ FWLbX[SL(rc$yʟܚ<]ڬ̢ tQO_endstream endobj 451 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 553 >> stream xcd`ab`ddM,,IL6 JM/I,ɨf!Cw:<<,~L*={3#cxNs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+kau Sf73? , տϸw&C⫿k*g.qcu~.]RWW4f%+ȭS"5U:"?igX%V)HM=pHըmM3gM'́E˻9O+)ol-RY)YV]3Ї%?nB7 30|YDWO.).]d%+~7{&޿Y]KW7Ϝ?s܊3X9C^gC@D`dG~O|_fwϒ\]8 4-Tsy6~Y)WiӾ,`[͵[%${eoOoO߬9S{&lg)< -endstream endobj 452 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2278 >> stream xmV{Pwv]AY#xmzڞX:zmQpTꃇD $ !^RH<;=hzvj=[{wΏF{W~wy|?ߕP^D")|zBڔKoIHK(x {Z4)x4gS,?NI%E!Ei{so,Y,8X ̀~02pjewԹ1"s7o+]c輽5q#A1^kJތ%*};&+"'@q\7lWV;펽}fpЁyP1*P4WG6LDoMwZ/{Fs^,J&E7|7X# ŏ] 0WfqgWgdBkKXy=@L'("(g ޼6cML6g٪[@frK< $>.<*+j5Xo;!of".Y[x Nd=W5,L䍼b / v|hȯvhQ)+] PKI՘;`|pcI͞č|QmE8 Osx+B]Ѵc_oCY^g@y]> stream x\K$q|oa|R.T(AbТ]z_ڝ&;\zPy`wG"e旉|_mφ˳}{y=ｅo0q~›p2۳ݷ㫕Vw?~0ʉ!t75~[]J~T&ovV6 hgúD?ӣ&h{ OwYOc>~<5&}s+D+q!R%sSwgkZowo%Lqs0lݿ<.tc>(@~_avסlB:n.5X,.&}oDre[C9][pWܛi.bf+]{c-i `ey6]ޅcskv޵7coaKBv$QϺjnn6Di.Ehѻ[F*<_ R-m=FP{23= |P?@u N ~iP0,d?\gz?\mwxܼ>^@ծv *>O}-5vxc>,e,~I:p]n`:.njQ*/phO&= d"0CCŸ6؄`A5ӡ wu.vd}цRn1J?8$9 ܷ3cMC\h8'޻O>SmڞI2?K+O{3Za=;'jώ*m@|5 4\A ׵l"@ї:>XE73(W˓{qgmxV}~17<L9i]]zenE7VyܰU`r,yH-FGt+dj6`>ZAwf9m0ish@ߐ"J"hsa+_ <+`+ɉӆJz@n!_[\ Gr$ 4 a{]pxpR#ښ󨨈近`bFJۀ,jo@Xz2> ?FOCQ f4rM$F6́yҎ1=hsE&b@!gIyH]X hFJ(xbD4%6yD1R',L94d{fZW:/LvWe6!J]Tu"ACCØXD@?eByyF %(a_:4^}L#,Zhk@GWՇCY@n0yqweBns(QgjT9M ]_"EBwon&r68 ǁ k=:Zvhi8@y9f3yM"S[h{%!-S*7Q3SLLJP>BH#~;zۺ"S԰~~ѧG0*xFm9FfS "IQ,"HuNkqAPsQ7APROH9Rj &fb*McE|_\EGIMSBMbnaVcKfK +<щܒlBiC~9O:qUjՏ}"UeXp7fOUDѶI4}[Ja̺$v^a!X3tvty[GbOr %!Ws=%qw9C"-ђ$rvvq ikf@5ry%}n[AeQڹp4b?duk%OTaZ $v-8JNE2 <3"$$X{_[52r >7 eP`Bon杵e lfR#X!03+8c,Csi @U78Dľ0` X24MS*fNi>Mй^j'٘S Y6 e'FL HEצ9eUiCw׭ҟ/vƕ|bE%Nsƙnܟ [׳$ NZZ01Ж\p#)6|#g4,+{:tR*3F1^ƎH@V {(Kam79*ݐ}V6'v\+U`t.TߌxذbUnB/?l1`!+tDw_F?SiUݸ\{QVC@]n@wC4^W:x͢"[ݻT7q\2t*iCDMo4@ SPlU/PPxX*u] q@u8ď5ip*PRp)bCf?x\ozfqcC+_}`5^Qa3 *?1ac,W<>hx.1*"hD _F-D46IyOb'Q#旊i?5vr:3̍~_oIV |zEz~ el6swq`7_ȟ]H$a;qP8oOŽ܆\CBtsTjȥV0p@vW8$'pG 0}[m\jJpEҷ]~&'.58r<=0϶JL޵ _sɕ}:z8/} 1ʸkH)\ |+"Pi=K1s\ʍv_d8d o% , \[JXs/ZbN[JuC/lIɚ0b B&7DC)"M=wy̓hTt&ƖD]8 ܽ =dwY6 o0s JC(,z~ lBGe+faqx=ywp>,9B,QX鰭 ,ϤCЭ(w %bЂq{U,?i:p6N<0:Ez곉ή#ՎeT1K%?0(% rLS ^,9Az5j? +3wTn~,-]m`yxW;Ίd./]*Lpt(Ǔae7rEe'UM|?M:F&@]Y$6ڔ>z,htO i)Wlm;SGru:ak, 3k!ar!mP5ݳLmTYCA_PU.R7RrslZH:c-+1fMD}y)AЌwI( *Jz8Ѡ&Ή0&.thGT0-B>(ou")`"}:)YD.dU`D3 SJH~viⵑn*Pnn20g>#&MTM:a"<%\˼̓sLs)*{"9i^4~IzZ4Lʻȹ5oaҀXμ|ִoɔ~F#O &'e*+!vE&T`2pG <$y6@h Q%&6ټ4`E3D\4נʈ4ZSf>}` J}ŲޡuE3[f+o-k'~I+)/*`!9ɢhz0PKLm<;V}PCQ1eM T702AOL1uaͲ N?F U;49K8@] vdWΦ;O  x 0/'ݜB饻p:4lX$1t5/^>Tuwe{cPW٬$#E ۖR/Vi_Y[[lAv߶=Τ;5C7 EԾaNu8}Ju5zV؄W<^(׸^x"=;~ <\廦@e ":pd8Qߣ EsW%Zʛ٥׭xyI_OG|8;i]1w C -Ż~:IT$7Sc[Zf@.,`]zĸc2š 1 X\!r A,:(0U(XWF>\>@\'Ô{Ƙ =c1|1O>'WmO-nㅀgu0./JW`?Wkh~\Dh׋f,^ 7<;ѢB6K q Ls9Wd69/ nwFN q]kTXHo0䭛>w_"|( vnOH 6h$/mfz %o0 glv\m" fhHI޶X_]uTBAb3|W͋UyQs#ڵ绶Vx _UXz+.aLvendstream endobj 454 0 obj << /Filter /FlateDecode /Length 4010 >> stream x[YܶN!yGN쁉VN9}HJZQݑfF_@$> c^ZW-.ONOW߳NO>[WOr|ee^I֧/a3Xc8qzӲV;kj_W5더yߜ0M9怃$0Y6eg$6R3gL#,Ұ/9j{@jSZ\cyr㛧 ΂M=[K--Oݱ?+D]Тpɴbu7oݶ;i_T5"Kx0 F6Uq7ezDyRβcKz~P7՜0nٲ-<u;|TBf[ͬU'b 5Ls-d*͓&)WSL(m<7 ΡA?[rynWzFEDl}91묏Լ'[8Z> )Wq՚8wUG7 ثFfZK.JsT=nܼAZ$!N?IbRu6N"(|G4’&Dy6bt1 įX)xQ7ߺrT :YT j׌>yWX4OfOh`v}|?m.seLl1h&bؙdO]|msw-F~g?c,sɀ'ݪaU">vV.]}*_]|v6]qbc>I(&zhLF-ѿ^ e-gpՁh_X -4̀98|8IP'j $8k{#αO8H.f|Z 0n ѹq`{:@,q^f֢]Ags Baչˆnl(`R7>;x>1T>oS#msY3s_Y>hs$&vQAP~tLx<_$-D ,F}БR,(! &۾_;Y6 .PJ-SB)f4_Ֆ>cBߎ`zo|=wc盂L!u"1$T(>wSM~3!J@ v8]ڰ!URy"FR(֋/È K|jƍ3P.RRZ>pdw](m`Lͽ`M.)@"h$I ڀ 0֓hxUpAȱ>U,l@\D/r1 50+M˳ll +tMqOHG=bە;/X1k~c4`P[;p;* wĭb~(##Fa}L XDEə಺Hb AN@ RduDi8l^ytzIȭ9ui<Ӗ X͗rzUjFΛzǸQ v83+;e+yI KYiujq4|A O%e)!hd0Y1Cl!|fo3$QlJ PB}9' cT{A?"c<^"ዄm17iMEC,G""&z2n1,N D #"^a$(59BZK m89|Jٱ 2JqLr:]LgFOcu%M˗:@i==xh ]7K.PTr % Iҭ{0ah:hF~gcmkZK#m~ymrw~ZW,O3;":E[gE1G`^A\~krߋKᬶLY;P+xzs4 uԘя}R$+oj\u-p]1.$7e=zVQ_upؘ0 p~uߗ|(,F3Yá-} Grk*eܸQIq^7Ox5Q"Nϓ⸛ '0di?kztd<.l,E}Sg7D_} Ǚi2?i\-c4ÔAMKe{v(|%T37d,Bt`qLĕM"60Z\j2HKL0kfAr=YmAÊʼch؊&vHWӾD#b`vja ЅUU:m|i{*T*6h=ui'U\ Ċ-r)H*00_ϣHM0*C02.KgN!qOuX>ɜP4t$1TA?h⹲A\qJ;<=W3N>Vޞo:;$Qt.؄APr7^y 6:V`ǂsjU+k3 /"=V7 ɯtE!v{"ȏbZǓzSendstream endobj 455 0 obj << /Filter /FlateDecode /Length 4512 >> stream x\KNUnoMq؉o\a]F&Iɖ}`HI rGCϾZt-[t/t}-.^]0z=]/󿬆'[\=]؂YZF Z_\7 O/9~ײy~ٵuo/2m\ !ڮ7}lV1hoGYk*'-_mv'敃d6o61>9h dD閥ZhTLC{ލp\%L/:qhרIgo8.f&bxe}e45UDk,KoWi;(tosmHcX!ѺYo֙u$zhLy5l]c ѽ}qcƥT`Ol& n}A(ݎ__& W?: 뫋.|@T| ]p ChvD@U5>]hOENׂ)BH4sDK"b50BkP k||8f61kt"Mfr@,8;gM.1k&b`j2#[.9s_jøVs7K}Cy|8douޏ8_8 دQOA SkN;Zk?TZlX,4Ib5ZE8;!2aLNLYEUbA8+3c(cXΚNlQEmn0lN,7gy'BUW@C@eLۢE(P'W ٪Nz}T5iX& ? 3"10]l հKTk7%mNi˰RPL_P,U8D凖`2I((YHDFfBtnC6EX") N5N 1ik\sڰhn[&A0fV[٤us7q iK̊mĉ9lO9 P z=Sgs9X!;ʇ-RnM.5&ٲ oܚMa>>MlrF,R4dpDZ2 àڏ$>n7+#CzHw"0d()Cvcv+QJ4گ_%:QI!|Xf P&g*8ZJhooG:y{Q ΛW~k.SJ*R%GFv!1)F ocYBJ& +68 g@QagɏQ@1H)Ǒٗ)v:)Y-;.k̇?Ä U4A}hUC 6s|tV#4|r{6 z,~Ow8uBZ [(4ca6wx!ccF,G\<~G˖ԜG1xưSb%~AJsڋ{l 6'';^I'r_YAaF UڤN 9I#E+HBi@0.f)(|ilR[ؐ#!ufU5.E=t5*ռy1ro,ƒ)Oa>eJl>Mc8s߹44;P1egB|l#{>arN"jٜ1.8 ^xS:!foV:I.N ;U 3˭ayb|״.B%Hf]Eʹt%8VaDwZ5f)I^Sz+DO1\?yG1b KW'Yg[Fl+kA!øjs @(ߛ5XePuSa`n]S%wT6!;Gn#*bZ/I{i^;&7H4BB=UěF""k|c@ Γ#4\D<{^,B }v ZNu qHjnO"١D,qt)j'f"ey0Ǭ9?Tˤ8)q2>g)!w2"8Q1 KpqTRz傰Q2+ܕp1}x (6I |3S9əJR$?ZkWr$;ٲ|"[Urya9q?7Kc]!O}2Hyʿ+wjS+gWbLI.b!͙2^/":kM%F")كk5-NRZ]s~0¨E1,Ar[pSN`Xk$06#iI 3s,B-b S.UѰ^mgǦ^tAR?* h n)GNg/!4 Ā6!CI^+Ћۆ<I9 FCfSZpt(> stream x\[wܸ>gQXNffN63g}%Yfܭ5_UD춼)P._ΛZ7/?k~9&Y}뜮pq)]4Pu>DF mM誁>X~tOcs8q.Ri-q8Rҝ+r+a]63-;/$Á)zgnovb}Kgj;y~տ=+qPp;j :Up ұq v]#2֭CG&R6S||-sݰKM 6>]-͵`}p@m8N[M~(]xxNFOu F \2] Z `9:*Nİ 9aN[!i@ nf<4ҜߗTuCwBؐdOG@S+9tXXTM3='djrԮ|V>xk ' ¹xyAq\G%Nt] _1<D(KK~NڽL__D҉9q0UPFaJL8}*m(k^O}lۏiwiW᧳Jp?F2A9̫j z C\&9=?_+`0UgF]Nyl/EZ9e2~=ABNAc]@+t޸/7N*@IDsQWqa X#~+|h3 /2͈rwo`F)rG74!a "Cl3I &+L p> 0{ti%9˿̝33ZE';πp9VrEm@v=5]]י\Ehm%2,=ht;zے Q7"nJG!_[5 *V裮 rQWƫ6ƶ"vHU> ȤS|əzaKacy ]!KПjI}N֛0$(Gi\9=V톪.i8en*YK$OI?4rhIB} 0o)@X2qsb]SgS4Mg?֫U3=L2=ǦIխM,-KJ]F l_<"bxN!0cYFHcm%JGcqlO ~䂴_\OMΆ/]{Er #PsuB)z!2@x&BJ<&+4 yx9qUÖō=QՂVYLC$M09ߥn)M.VͿMq6i}=Jv:>7_Yx +cܔM2kUcxf 8X=ZZ\F sb&bHq%C肇u7diV(4 )%!M7ᣀjPQ2#[[g`'c?%Rԉj*Pk c; ڀt~?TqZ.H7gԲ5c ݄>O)(loŷe~]Zfm,ɗ^+Lla;|h28 fI,!F|Bک)-x8 `w#K,FR ߵv`.7`kᖴn$Xu#%Slj_ѝ@ۉ,Vp*ϥ]S!_H_8ti*bce, ,)iWw}Yec.^sG|I%6RBw鑏%9LCgX%>a%݌0 u s睘 aaHܲ?)vNԞ0" b;htc Mۨ8EEj]~eNwE3ؑ`oc ΐ@ghiA~T]&] Ӑ<.W8ZK%mB**I.FX\En$ ^e,8Dpg@HQe_.(RNQv%7!ٝJ .ECnDk[򗫔R8 Oߖmj,.}2cR?  L03dy`Ab"ɩsՁh[sRyŎzRe|x`YLV.qjVQ椂8SHhRl +)pRߎw,8LkDt;Z2jyEG ~*T O VNшXĭk^W}?AQ![/?1UÈ1 )vm~5mm[Boujs@&hvLb^.VP4=+/> iʸᯫO#Sʽ鞲8kMȄAyE}AN¸L_6"XӱP#.>Tc>fp7a==:R?Dx/ ܳ82Yޕ`t&7}$P+x$:dz$GU5iOp[钔+0}4cPw|0ie: (*l5]*J {X*an3N/s:]T~̾$ b i`QZEljMgi"xwYL߱> stream xY[s6~_M^XJoqqbRxʊVM7{@2K9cgv |$bW#̎E1>Tv&6BǚSƆʢX+8ef 6oF2$q"5J7J#&h9!4Oib^SE<6Zn似 Vѿ?^GoFvHS+X-bH2+ͬGCIc+T ;2]e^7*Lc$NVX7S9#8cz~ܼ΋?^'nn߃,YaR kgHrH 4ɋ˻j_ 3H wGu[ QԳll:d4Tzη", hxL\P/M^}MxX ÜG%k@-@І'hMh_!lO'C@>)P4IwM8E)I9*52< 93S`zVL)ZAwy6\?#P:&_}h^H#Iބ]E{L 'y.|nT'PpS/5̊|]oC`1:Hk Y uGqA.>gC(ēٺf'}4l}wcp*߬g?8,U0eӎHb%&:r1rHUQs"IƦOT'R!kZg8?wUX6 g!nv֫-< a728}}eKh6}[?_cÀlĢdZy8IxMWBmIc$)پwFPduNlyH<ܹWP|ο<*̷3̳$m_m_Z}}6szyJ*$`hkSc4ax_nj_@J-2(l}׈wm&M.$%TBdi":-ILPrwbhxXf9֟ )+xk>|3 4aNG(R)YaO< v]v~ m{v`Z``?#;/{482"tW ,:ݒnl@2Lvv~e0*bNWFʶ{Jo•~Q *Q9׷p =*_dO\]Ƹ|(OS|endstream endobj 458 0 obj << /Filter /FlateDecode /Length 5114 >> stream x\K6_9TĞPēFkFrX=;iCA[-TrUIy3 ]=vj||~Y4X4_Y>LE?; Ojxxs> L_2i\VWoϛ1%儳Z/RuӨ.Q6 ᕬطGQ#}jv|%|]پ&=Jl|m@7z1{vHW7Zjߝ_'yA\\UB_ۋnn*K4FOVgf/7A#k%͢:O:2+`Z WH&U#%9WoyO'kͫ\l6IJtsDBüj;?Ww_z1FsfҜ S-nkb)Tm@wދ 2w~>;Wߏ@vSvʗQ 1E[cs6xOx۴A"ˊ势Y A'^nϷ`o_c@MNɋk+wu{36ݺ_ňL3wF dU*0zn7=|[ \`ml H% h= /c6+dO  v|,sl GҺ 0P{tI?+6 9mtAwY\"-mae]}֓gg#deZ{<=}òp R'¦Uj"~:'4 })5WBmԠ!ŧպo_ u KK9_bप630𵒢uS4^V‡VwC]MA{t>vhi2vG'}fD _k[DHY&.ftqݫJRkDŶqu81T\ gky3r !gQ$>$8H s.|  I8j|TN X^,_ 4ϝD#%\A`c F@.$Hì έ(S+W*ix`a I_}3釤` asV{ߘUx!S(@sò@vBFHC,iieFمMmBeɛҾs"9H߲UbCǘ lq. hZ̮26U#,UqVEwXZy8bPi BhQ\is{#~%TGKӹwWVg\p X ϥE{w6>=$@9 zbry|[&8zK{@!O.|tlAծ_ޜfpT*\$bQu\QcM5~dѰOW,@`CK6<8߱jQH/Z4/Ö1@ +"_S^0s|{oc4Rd`xh1 I"}*׭mJ-;eVr]WD?I~mt|lن@[ =/h'"B6Jh bra$V1x#oD@;>=I6B8-sl Qko9$[HlҲYbY`3:_ȱs%5ӚE$ kŮ#.rPQn a6 BlϿvMX6ByA9O0ǥϧLR %ی]sC.}20i(0iL )w RT-r#,x>}+-C 仐_8ʦ5 S=Cv10𐡿!Ud$O7wRb h jxBK`'jd/!7<65zH-av)S]ZSk0ѣ_3\]yndc$L픋ޝ%#@C너-if&{L*/BfF(+CbKrqDerr8Jg */j($r.1*('V¬Ʈ5-2Z손nD³* l:?"$SMP> cI-C`bP=rGRQ`01]S[(i V}PH]ZcFD6>GaD gc{F" c4]0${ 2bD$&LG4}AX29fOUEL%dzĊf}kta݉,{[7x0=d3~vQwٶEpS4L3Wˀi)= CCRN{R}zb*6nVqI@.@~SpL4JV}H-OR^I м\g߾KϕKT0$1³bJі8B s +=rΑ+4 =ua|lXЄ>m]B$`bf'Eor!dTahGRG2k'Rjp-(Ӛix,v(JVYLHُ79"mngpB+;nΤGskH270 Srv}-Vku>]ņZv&tѬQf0m?NoĞT -J 0SG%OAMC Rr];ݲye#@n夞" [B`N2u+&aqErJufƶ0!\?-ؘ{6naceBؽ]g /\;@{~L$WiדIp>亙ZWOДS}qky?Xs+z[ev[k 1P+edl/OYg 9{YS!X'R*nAn>GDB &h9Mg/ R}-ŏp$uQ“ϔ1鵊GB.c^91B`Yh^NIV|tCxǴcz1`dž ~;҃i!:;|U_WޕdVgd|66F0"G89n0]ܡqsV2:8SjH'e;$"ÏWvMEQ@wZǰv;s6)e(/I!ΥBpVTv=5j?~0)n?k;Cb>"2t=>h3f'߻EEqV{`vpγԖ.~Ÿ BGn:2Qbt` c les,dq{żAL#w%;RD@_$x 3H=ypx ~Žn1"cyTGx{p69&RRG3yؠK[zlAz$̙r|;AiU2e Z[3 [.MHW 8xP~7VݬnE77;,Zu&.Qf;;:R9EGѡV-endstream endobj 459 0 obj << /Filter /FlateDecode /Length 579 >> stream x]=n@D{7~d@n\\@" S-gFvH"P|u۟untǵ_?֡uz7}7^W9iwi~Ц{9//;}?4\׶9}=NSݴy8ܟ8O_?8QKUP UXUA=>T\3Pԁu ڪP lj EEEūQ`ͪ&+ ! ! ! D&*#De2T"@d2RLTF*HeشqgƦ;xMFfl51qtlٹߥTp |SRp*8x]NfǛw}wT#bhF#bBAB#X1dpQ*HX1dp%KxCAaC AalBFAĨa&RI\J0)K &r)`B.%Lȥ `R0!L &RI\J0)I} }tǺ{I]]uS'-;endstream endobj 460 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6823 >> stream xY\TW|heHԨ؍%`QQTDH3tLޛ`I"X2ƬĈM6j}D =cA FYXXL5+8sxFz O ~0~e8mo"c c=+~xT3yp y?$4&_ΝK]n/~YDA[:Aۙ!}lC|l]wnۺvV[6msj۠Aּl~蚰"Gnrʼmt{ߖ[]M[j7g3w$,\x)S)j JPӨj:AR3mԛvjF쩝\jGޢQʁZH9RFj D9S(5zLFQ+1Kjj,5S)+IUΓ딚(|ޙY%LOR&'2]Yp'-uS}A@UP sJaDC9BWE&eW#r5Z|QXN6d<(+f8ͰxĞp`A0ns ZH_ OJvܐMXܾuR0X=5lBolUg.݃-R:@ `DC ˠY$۽w/tTطa06!Bi+wR38u.EdeDRzf}e}J(DW?AX̔R}JdŬϳ{ރ]gu/,&79og%V qEpěK"|XK-U^`>،&hMM4% ERNŀ% ҋ_E197 蚀ncQae4n;diT6Z YG a/=vhJ @o+ˬSq\+Y9' nrxg?܂  ,PqW :'G,lCoT`5x5 GɶxJhAa#eJP&*=! ]{ބwS+}χݰ-?^ftqiM %eMo#焙B`kD1}m<ߊb]oٽށ͈E3jCXmRK `PO1$;= TC2fxTZ.avMZYՠk1; qj|D XSPIձr'HX g Jeɺe4S䐚x ',-GB>f_ 6Ž*׿Hbzs%r^0Ma6%oIKq$/Lp>xY8^Lu͏R2}p=nƧVͫFP`!J؈_SȘ :׆e* #Gt׎eW1t[[*Ġ^Xnv V^R@8C(˿K< d *!o̬*,$D9t&k՘7agtg.DF08QLzŐ< U~mù'v7%ƪ.5 foOOGd4Stx*2>:δla/TgŢ48)¯hw (7>یjB-Kղ4i;شBWkSTl_K]"B )+4d3jJ||PR<}d0;L3x3@ h34h'v%?KϦ瞬 vd% CE$ x/WU0ڎVW>")i kEyVwi36Ɔ{gdf8Rp m(b^O8}>IT-H@X JbEr\=X9хF ɬÐ+M! []kd nNvO_(c4N})Cr*!</K!HSx+؃M @zeM[=\ -@Þ/0.iYloB(B(/g xf^fBDrM@ OWJ(^]l؂&_ޚ !]uZ5Eݝd'wgk40vcq׫h>?'dq X'aQvnɵ)ꄖ`]3O ge;D4FNWᝫ diCԖlh@j$|A]'AX_i= >Zh1BS^)wrȪ{ D.b׼݇rNȧy/Ϭ);v;`JbG|^XS.IyȁCȡ 8GSn-#3R\2>U*ideD,V\mwVb} c:|@k%dпh};ID&N2IacR(;@n]g*Si%3SHIi<I >ҤYmfq.O\d 춉ڸ<dS>1osYř9a X8WG7]g[k܊Z_f*t<Ap,HMUh:H‹厱36xiSd4"+,T mr= UfNMn#s@ evL~YFlԷ<=f45@ m/=0l*"ϒv!Tl%"ȣ$"UCמU@"N)F[kyÞBT ph s&WGԲR)"seh؋^b0͡+ wpG@na^|$t}/;U 脦f3d-S ?U!rrL3}}zC6!GfC8\GUFբ5hǷ=fav:%|,x71K4Czjl:^[٪667zmXKLbteNUHۜWw ~gј UEj2.QjŶP J <8UmY}ͧKͬf I$%t5eHU!iᥪbgӟ\nmT,8*3E`iD>u W @ccy(}j Sm0_(_3'OU }xxXQLkLLl} 9nsAʅUŜb^Hix V}^'}E,})]CNHSYrDfM_Oɺvfx7?G>.긐{Up1=iʿ*]CVQZZ|]zCTU/(',<7}sZ<8>#7';o8]~L^Thk+Ik _f45<}HS> $/{s^C_ܟdMUCBgoN)sBt_iH6 fD'u,CiaW5q8"ۚ h1zLE\{?PxD-R !٪>:&-$NaEV{cŠw6-%-SNz]nB(+) nR}< A9heXXh5^Bn붯ErJR*Ų:b_u)dYW/qǦ_,`MHXN&5S]8!=<)p5.T8iQhgASN+TJx'( jugPrD/UeeiL,|uYq^W@N"DC+? ;3>oKٻendstream endobj 461 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3925 >> stream xWy\Wמ1df J$l.XeEvPD mZEjZK */X- ,-Fժ__~/3ɽ<9Д8iC줬Ԅx`I Dpba1Eؠtڤ8Sa$86&R"^&2|9s26f&dɝE559]> 26+ҳSmO߉(Z,3kOY~rWl_!49%a6UpaZ߈xPnxưOF.F}g#ws$$$ pD눔SpRB:d8C 16fW2i'0>ЀBi[ǒ^8c.M(u%p4JB#فYRVzrjV  _eڥ.M\ TL+~╊* t*8pfο'^Xpy?:9+PJ(Plܞ{ 䰒תcd$*xlbfkX ^b;YIl'-qt Hnwhd& Y*aXE_ӈձhqZdW5†WhN@$7#5?]A@`t+/,Nj`Ip&N{4SYq0M 4<e27 ߔu%,“Q"'nnwS@*ᮊ4A38@ A 9 @d<䅻lq0zϐ TF+TބI?*'c*ە*M[I o[)Lo4c%N vD7$OY5PdJW00&ޱZ ^~\Mں]I Yo J=㒎Ȗwlϱ+9  Sz_tj}J~Ңٖ&Y*ث2]M-<9 6c-ծ>8 DJSf `>쎜WVx|,F؜Y0;A]?JKmMsYGX`B<Ho>)`_wUvMIh#HF0}茠Ł}We1m=K%ۅl3d!g%5>񗾓 B ڼ7ĻՕյr,)>JDi≾ b=mtX.x!JrujtSBJOXgc^fnFj$jVذs)LIWJ at}k ND\N[V[%[7P|e}_uq.gD˶s݉ s?^X ^C&'n/gqx(cW^fVjwW#. \í򡣲#ˏrz>tb~Ty҉łX_0I=8B؎/\R s+fF#B)u=pGM>+ ԐC{’͡28,\kd#蟲A_et7`Y(DNON&BhgTRg|tl-HAlN2t/N?v+P53}M_I =(u3߰ᚷ6&3f?~/ɗlTZM3Ws@K[?($$vRo.G`lV?i`pXD:]rۨKk}/3^K8 Q`w5zf6'Bd`Cx [o%./v)YQ%[y}jʫqY,O\e.|Sێ``P+5#XIīa ,ygvar~ٿaCm[7Ew+'s2no\bzsDk4"T&̕ @q=q)rr鏇UCzEHn@6*9}t#ZǹM@樢<mzw!l J u%=Va!E!LyIi0E#Q=;O $tqSkW>˔PJNHۖ#)W6k =P7DhxT`h=2nM娑{\ pͫJGU9?BDW+|[[ҫ vl놣@:C"(&(Dau슬9Oñتw|ۓ{ gaΙcZG]tG06 r\nz D܆D^sWU zC4lm_K?43A9Pə#'KUր;aaef:]BHk|T -2?c*g\""lc~##/(xSOk0a)$}ʾ0&.jǖmwlWf r[묍x'7-1OuǦqɃc $nⱗ^wY ,n׭;pǙ dc:q Ѽn3?f.ם/nDӦAs\&A +(r)ǴnW` rgxZt{rX-kc NlG_} Ud<0| S$yow!.a%WWTM#,_`1 DlJo/]t5sXw!dS"֟kJR)֧*H,6Q{\AX:dB^iP#aR?)@-0]LrYKSJ%/Ou ; S.K%ØbZeKԴ]iI^;a \CÝ470dO]5UD cG>@.Vu9܎,mga9Oު~+mf RAmr QwtO%3*JAM3 5F{S2gendstream endobj 462 0 obj << /Filter /FlateDecode /Length 5263 >> stream x\Ks7#'6X+ ByPxgeL2IQ%u媖hPDHQT`v7ė_&릩Ŧ/g3An./ξ},|SwM'6|Nwִubr+՛mS7Fz{pURnU=f꠷H@NɊag]7tG^BaM=?tqCWәC߉DV~?LlD)[ :۳s\o_V??v|'͸~4|ѨnZ)vh.;~:pVڵջ-vԦ3oeu "z8Sd+6Yc+EWmU| DQl\ѵ2Cj8M%X_mA( TU*՞:|E㟒~8w?pTS{ Ju~8%6Џ,pŮ{xm`Zvl cKzfze_Y~ٞ:k|z98ՠ_K6Vt]M bLJiM'؏7)X\_ S8=ԛB{u PT7e8|D0?a5^ o#t}X -I{&^uu &1>鰜8ܙ0q'p.-tsj8eGvnF4B c@ [4aYRKfPv~0Pc@1^<,yl6 o(#M5ў/׵ PZUSJ e[1[%kȤvʴTvږ8hc zv/΢ã ]!٩٨,V-zDq-F-[8OA}!t< < זI_xw Gv'le8ң /BA{wHQ8K?x'i⍇Tiv[b/]8=qKfLjcd*,NE@8pwOil+LHaƞ[b3^WfThZ&.~5RWDwa!$@DhcU]{Lqp Xնޞ[!y(\rsB8EО+)-JXTp[ɹ+[[MEmBv]\oϾ EZ.~Є_wU;&q~ Yv( E.6RCFĸS0` =(ڂFqdijD CRhKTIRZ% |+fIυ|p#:a;gu؋6?qE+iwK"qB- 2!Z8ċ@(:V:s@]᧕6vGo`mU4A etI[~_:oKwImHu.BMgiA(Nu66h$@ı߅5Ȥ}/Z 1Z[Ky݂4w!єlҖkCjQ:`0%N4W&iG` ?|<`0BZ3¶YCW0S}h4, L^,Er8YPsN]%"xӆBy'f39~gYI~~o\qw:m;|wbH\0+Ti;,h|mAaz2a (!VSP8aQFOt?016\gͫkتU?[˃ $ K7 }xiZb0A"s3co&3|:Or!.D`r:H|]3Ik jN& (#:0k0'/pe$\<❘8#'+>.^/ps]?(X/C{LEв>kwTYaONP =%+_mn.(-TȨOvu V*}lMDW掛_g0 0NF"ZPmL6ĵf2rڎ+@XW{h,dq;IН߯Y(S* Fa${l'4ܠ>bAW0)3 (ifTi^ximp|J kkY*pJ)tEӃ^hk ONf2+iʼnJb%&\YpsÁ+?ĿeL\+b>*\@[sO4(}2g яt9SEn m MS_֨H+.(MuTb\D`1/쳳w%9}dGSwqs]`H)$SVy"uMzD LAaP\6>oYOOYyF 4'q7jy,5}L*R68dpeŵ8)щy?xń fϖ g ȾR5]-_Ckc?Ӛ.%W:rH:FZ⫿ p\}wёzR}+,D_LhٸiLW @ChBM^L0DTkYNܼ]VK\c螌qveΥji^bcWVzݑ9hM ":S_'0nuZS ^>ĤB- ߶@j2hMu~x`,0/l^D- ȵФv 9hb4yFK )%/OV_:S&C7TP^4Sl9[>(]OcjخJTRTdJ*I-EP3+EdnvD.M=yLؙ>$Ҷ]h.rcBbnzZ(n'`))6A?4p N~=Rߵ&E Dռ4 .H&$J,얅#q>Ifzm'O!v˽:42yPd6ܸmnEQ/7գ~e Y߯j5* h̎=RJ܀P|  l˻R#z~h"_rzW*iV5o&ۤL5-"uk<Xn#G|' ƍ%|ZJ|FM~N _r ZFl};->D1o8\LcpAg~qYi8p][D)1hh\;;$8rQK(_{ Wkj2{%ǒVUԼp8L :]ر+%>"D1?dBU3صOzSSUI_x-x-ΏT^ݖ,"%! 'yDj!:^¯GZ;?et"مUN:vUl\ 'g*C #Ɨߥ_t3ECM+H. Hox}/HhXqdd0.no%#zWe{"".2r֗RN̬ˣ.> -_VRB^::>.hOCw鷥AP^yɨN5+ &QK'c'eEsڱ蒿=]Q d2rxQX nx!Oω{S=S^pJ!yqg$^[xMϾ-*!7(`#KM[Z\`߯j6BG`0g[YZX8d(o Wp1Y*EmԻU ENG_IX 爺&爔T?%/K_SUDt:OWVJ>AoBj§K"4,endstream endobj 463 0 obj << /Filter /FlateDecode /Length 4747 >> stream x\[sܸ~?Hmj)7C\ j?{sά6/9+u-#PԆZEu;1x&UiC ~92Y7 VK ]+S$gp~DX)5qAdS^17O52prp':uыƪ{?Yɇn\GD L9nHFޔհZIULI4LVQwO}-S(]%_\k";MX`@xZfV8ݠ=ol8䱑BVw jW~{ ._GO)K3tn1V2G*{#@\Nr}RQ,/u_ogՇGxaIūoO3P3!+8XQZxقNFR /+-ۆǛ~/+L\/X[ZnqA0M2KΛz(&B)[R쎅x˩2粭з 0^O\4ZIKY(y$4iRZEtB;VYg(2}3}<iW`0楋T%"Ae M &Px#XFB =[\ VzpJesp)nK?tjv"kBl}$DrAnEԺT}V!y x9[EuP[%A5eF험I@d3{|RB0y%&zgNYtLO}s `~IZd#b0 'woW.|ہ;R0P+KvVe8\Mw2o9IbI_Sp}BuYFl Za| zu8kM>S)'$NAEyAYP~("mR )^qb7z C㩘F]Ji lF\S`SP.R39W3M(sH>q[7*AYԭ'X: io`D ?lP~Uw&nzBZ/1&8zgY_7nzhevQ4E bbO . pzm/\c8M|!.z6xh4M:"YdV#0 -1E9gp.FI] ܳ 1$O>z|3^҃&yVI4 ѩ#DQgt%Ak^(!В@6;8d$MpeQqI:5vVX` |ҼY\Fޘ̒6~֒+Gƽ- q4G6Db0i#n $ՠH3! ĦoT"~iQ3X3-EM#Kg gCpٺiS EOIOVo#-ypthKBU}^Ī;BIL'Rb[4̟H%*?1jQBI?]:1E7@: iI\`>lK,dS$ԕ;6bF. u >S!ߺ,#A|`W\vh]ã'?}&3=!}n_Oh2BLbK_Y20y 0鉆1xLf4vKc)8% au~V=T?@͢L!'~A2)oi|Q#_sFQ:b~xr psÈuۭ@o St$7䈈Ol5`V WI.~JT }*wU!YJ34/ q;2OatJ"qJ#K0.E 3v$Z(bSJ5t/(z(Es7O:^3%Q֧̒߼-%ٺdON+FJKkN=_pS?Z˅*sq$֦`%I-b^(w<v g0DEUZI=CVӉVXocy7)WXzӽFKF+Mv. Ĥ WmxJڂ[rs8Ld.߄=TGr7SakR(90n>SEJ \~ucJ3wkpk-Ya9V*#ecok6Dk Ë>WdΟn% H+j^qketk̥@&I[s̤%ݧPT we(2k#ձ|%:, @^%.2kc煟bt VNDs:~!dºո:~Cz+驭3dҨu KuӤ&ESJR{sq?R-ha09(wbdB=WEw쑶+7>pQT4F|Y8swz*z%~trE."5>x*O?gY˵z h%]/p\2Ep}><()>0RQVLanvu^";7(Gl(z!-y4F)zʳ4Èh1RidnBXL'9 98V%v,wW r^^-tpf\Ƈ`GClL=R^krFWbȒsY$9bV⭊IIbmzmeܤ-J9=pum`#/MEA߄XѧF(lYRJߜH"#,,W}q-}_&hM_xpad;׿èvdL_-9& B1NXҤ… ILW&Zz2]]T$G'C5$\䛳Zendstream endobj 464 0 obj << /Filter /FlateDecode /Length 3582 >> stream xZ[o~_H y Op\EM)B`)m2,?s%wyez;;3mߝ8-u8)NOޝz{:~w~/UQ'a3Yw)O~>ap3ǂV:pl&WlG4"wBG_d~o`ɡ7}M:S򑂍xUY"{asm`cG=j Z,ІN #3H%5<^_ 0=E\0V&[fu2eSg&nt^ݑ0 -}ScEH,*SA; Wno XU쬺Naӹ1Vj.ƍU`%4{`;S<{qh[z7-M0A|*;AW p;rwݒNN4 8Cנ4=z7DXi]睪p 9Hڪ$/: nFca^y:ւ xx+ .*y4f9&@@=9g%˥nJt+fV(](+,um))͍%\?G&w:1$PjE$Euh)Dn!Lcgߏ $,mXrS; HhVqY~;)+J; ! g,,48F-r2F~.|B5?8ҋUE+9]ZaOC6!F0>J޸PdsC:2 :ՈIx8-c]~)s!Sʭ6='"r)a' ֈx̀I$nT.'1^wuL*8`+FBwd.Fu[#\Qw'kWBa* y[z.Wz_J7u9P?'ͅ_hnڗ 'K 8 *MZIKT[?3҆}<~L捙g&Ӝm+ Z3:1j4[Y୛E+DZh!<^ׇCڭ ȋEs R`̎ ;͹3Wur/%Deldk-`FO1Ӄ{#a@c `E:'eU=3sqʜcb7g,ᖃ;>'JcP`<Լ B[*gQe?A 8|(1beҌ_"8JXM S:=XƠ5a ߥ34冏^ˊ\:DkDuO݃5htgT0+sLz,깚颴cmÖ[xZ+ ҲnĵoMljU Xm\V{pe9f8T: AAd ]fZגBxr%E8^F%]i2!c}7[+x^0\G?"nfsRAM9MY)0M!.A2SF 4Xr դP7?JK!}Ӷ#nWtuݻ褒j_j9_dF_2+ 62-,hJPh{>4 ۶yEg TREM0Rţ>ؙY.˼0`B?ZkX@5^ m+i-fd\HYh&nCaaㅖ{t+bĚm&8Z#v]f;@"=׉J Qi6 &2kT MJzc9o'=Θ?AD i!X;Pi/i5LE`PWFkj uX ne9־|= 6RZYy1pNckr> a]G3k/ ;Y/}qJɑmMkeLt˙%rjjO=EHc] vU^~|+:=/m32ap*{ FQUp6-1]؜L14hC%2Sx^a{9}^@(p:Ɖ(aţ(Eu%ֶY_$@!i8w0 [}??/^WE'QӐO~l-eݮV9DdGWM[C5K߲Ɇe3l/<^>13wچPV}1 ^ۼ"8g&] 0x6az_osnF_ ؛_ :ګ;_d;;C[XWψzR9_GUtUvQioTVDkVk*eQ1·W3.q[ZM`=7T,S&[H؏1 ]E%Yݸ`[\x5nd4wxqzknܼSv'_2,xD\jd}zh?endstream endobj 465 0 obj << /Filter /FlateDecode /Length 2974 >> stream xZKsܸ/ 0*ZNfーg1PKR*>xpci|D? oqDcg_G#W|u,HŊzL3e\K!#U}tMޕ甓8E"iH^,,HX&IqB.r[P (P #m{<)&g:jrѴ;i{2mP{kNU'aYs>_$}$IQYmUaeߴ/ZkŒK&yK@ HZW4_ 0#3%٬LE4EViALpT ]<>pzooaxƀ]vkv)SmC_>0ƒ91SK1G۲8X|~npN`܅X5$ǟTQ50&7_|XPr[!A˪o#Pќ*oVͩؒ6В&8;3͍QRAI_./ y:ee2ң}!v_(@D$awvyS; zHpV9 kuDK:xyS7X2Y,4,,rkSPJDypLǞK8~GXJ%/- R"| X):V ȠQ23vڒ` & a:h XH)6N 6q@ң% G'47u?ԕȩAfy(Ue&ͺ|"6Dw]Xe%)i^g,%#yʞ!aMjtL}y(%/k-ߩ}ֱU7# 8L"2nFlzc~IwU#duhC5iPaT1ŇL,\4ߗEL轰pL|EzwjJF9ױ>QE "pZRHGiG9$Mk d#tմ!f Չ lRN3آߝFB)`AFOoT~"P;uviζv#~, ;R2G@P!|JWp4/rpaPSNl.70?܀|A'28a爧}@6 LxjZuP:/}ۼ=`iiCʩ֨4LOAISF$8zm.%S7ʉs%v))jb1Iz:7 Ͼal)7FhCo"cc]zb6hB;iIp eMmTprP9CCcm1w_~HAK 1PHclFD c|Ab !;[@B7>(> RPan;`q/4ugvך]Nugy<Մ&T+=\* pL(v Ġ3V[M1i;XJ(ou%9)'93Wq@;!54{0u&hrz. #1*NfBntV(i^䈮v}b~A(UCư4FTCN NrYW` )вnZmi4XOHPoK,ʆ OxMo? [krE\%fbƽ8W([ vbRtB`ȱqgmn֛L+\MrV IG+ݩMNw7233$հS 'h1(0cJ~Pv߭|qpM 'Ce" ɟ0QgUbKڣQA)_odT#Ioϑcl@$b h*zG^}NV eu!ZUaz Ӹ7#i_@ wm>yi$1;8Jꦱ.(Y01 :9u}TB;̖(t,o/vc",U²vf`>)rr~'؜)yks{&/|[~o|VETH;*7e x Sf_s`ىM` uˢfS5jWhD)}3P3¶\j /ȇ{5"N|ij쀁o߼ꥫՕ3 zu[65A[{_]}Չ Qfl59` @|uvbpqZ}HaǗ{b#t4I]K_`~Fc`sYV ܆k40P"BTEhS0sה.D7!tmW92lZdwb ;W0Na.2[sjBzշ3)rBtSt붼Em_ݐ]{0bPU+mOp!~x+wrl\p.􅜷wݺq޿WVwuۦ6oJLB:?T|ϞJuH{HHk4]ٰow1g{endstream endobj 466 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2279 >> stream xmUyPgff[PgM"FnY͢(x 0 dFa 0oCC%0eܘDJRkJz٤Q9t{_~MWގ5.ҿ<{V*!#56yV ҟ@6=(\ T7q8_lf4RԜ9iɆ$YBڸ킙ڰSVzJ6֘ >Sܔ%&k8}Rlj֔]_ ]]jETDs3mOR632cթs(jA"TZK-Qbj67*Cͥ)oJMHPJ@}HӇ="<(XErj<`_c^L\1w xA{> Lt_\{kuq+!%otJHАu,:תYBr0L8Tޒ%N SH)hR㤐dQJ7y sQ%%$ c0= ꮚ#G`)[`#lAֈ8)bZ JMi3?'؝DaI&hڒ&+C7RT7=z4ϟh׮n,vxRty n o"uI~?}2 A^\"gU!{1+%mۨB'wjUF R;wo6TUjj7tt|if`--nj>ϲ#l1U[6imu4])'vvA8(~](csdf lXY uByٞrt^憠h U)YX bd;b tQlԎ$c4\j D⅑:0s;9K;>Z|[sb;@ʆ@FX, (val '~OFa}ln>K /S*R4I-i%F[@LN;c+,%y9$t΋ C┑Q5jK`|V4D!Q10'i`'݊%dJ-vꡅT-$dvLOή]FZʪJn}%XIF̽r/P!|-e!a3ֵsJKq q )G센bۮb +c`9}9}p8ncmA؝ofg}f_HYDK&؉'S't%p"9eocR"8G:pd̴t2?tXoP*>hJc;pAvnNpԻ!n]~&ܘ EKv Wf.hU6("Q\ ǿk j dYVGW{+c;yG1.5/Ecx\pzc2 ѐ`>u./!Ob J69qxW~v("Y=qk^CLA+"MfMj5rR/S; WWMp?3d Vm?Z@;s.W?;'VSWU[f-)<.m_N{Y3C/^ O 7^x0Nزn4`pl`{s,_$o-u o19[vЏ'w~(glT߆b4ϓ~seo,[}4ɹY1 ]ncB*5 fH;{>-*KYrW6_id\p^ؒqOf0 [&toڷƓq!DspƵљ+/TƾmZ2o@m`k_9' }sƣpm2 x4UZBu&D=*~A&蘓}'e ҍ|(_nYɌ= b˿1Q.kQ!az4>▉Ei}/G8_zmUvAn@GT:,":%A?\>+GVؓ nV薚ZFMsL^Zf)V+Tk<(endstream endobj 467 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 321 >> stream xcd`ab`dd N+64 JM/I, f!Cß^<<,$ݟ3#cxzs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k; g``` b`0f`bdd ?SUe/>0oaWw[V}GoG~zw#/ KUؾs p+]#`-ýyVT#3z@| 饁endstream endobj 468 0 obj << /Filter /FlateDecode /Length 216 >> stream x]An! E xVI7Y^dxHےӦOtL9TI/tNYY!Wp|u^H܅8ʗC~ t-SuL` bDE9+=%d,`S̬XiPh4[#`N \fVBS/{>69#Z)or!O~XS~mendstream endobj 469 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1036 >> stream xmL[UmWCc!ɲEqQa8MPزʋZ(R@ eM?,D?,&rn9vHL<9;ϟBe DQTvP紵nq>Pa%)qJQHJ *A[YMY <anRQT[ӎqN_`VSfLLk}{=%3OmLyd`!s7ssG'Jot>S;6[Vmbv:c&ˠl7;CrD ;h^r^tE9j*4O2:~* OXyWYB+Vm(^QZQ,Ê.PQC՜3k96[֙e9C$ӓ҉vQRG:>| 4~V gZHqkNWpVO<. GE/hn HĘ=}`ev5 Z:㲱UE^UѬSn_j7Lrf!1)%dMc]m]nrm9M?_<!ȐV׾0 vȐ-0tLO;Ӭ߮ XYd־҉DX0n Yj,oԋ <e=yXo4q, gyQ4R^O'S?S,Cy9d|Y)iR9-`,Uq 5@ d$OJ4'6ۈwmFjKAi_d.^\jh2 !d`Vs|* ]'Kբ(bJ6N*{yu7f Ua1.VfxpgBd(Y?^~0H'XD=x] XjҪ*W4ʮ堭XS^#iv5IFi1"7J&5endstream endobj 470 0 obj << /Filter /FlateDecode /Length 253 >> stream x]An0E>o!!MɢU !޾ES]/4z/KNs ?glԍ.!}g(ip=teGKH76sON㿭N ^zCMGs*vYt :@Fp+&Z6@#)УhK IP6^[yi11Qk1e X%hNJs,,0?endstream endobj 471 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1906 >> stream xU TeٙW#Y񕙍>!6 Z_(3ASX`W`yq]e*T|kL|JbMbm-z^{ڻ=9;gιs=dT`%B.5d'#cS7g%_NȤr- PAxf,Pp*P&[ѐ;߰ɔ1ݨN'$f^&:19PIԧh#Ehb efAIJMOJ4k4+iƾry~y^EQ/2:ikک~FEMͣRT QAT0BPJE2;5 Zi@d|-x^1\KO73 qbS J dNHG t(zvܤ,6UcUqK8pZlO3>'r_sI9Tx%} 0sYLRIqAtp(y86rnSoo}˾NcYp{| >Ya[d[yX?\<ȩ:S RZ^zC{/]CZ'G~'D&ʤNB2(sbk?p(7_v)JXVaR(XK玜o.QOŁLa?jr iI+GEh m~K[]=ֽw&GrsS{I)8R6q<^Qw v梀VZ&z/Q*OxeD #yB-| 6V+=R9Mz}Qoik|P$3A7\&|/~^OX/L7bUH*~}q՚5CLR4 F3eW]HR7A $z!xT菅%$ Hg:M-)=*GO5;JkHb AcNu{jpmklh1Ex[lKHPÃbD/Cko-WlJG< /(ǮI(-ۡʫNUšHC)Yv2itAݔfzh4Ov=1؍fojFzЇ47uCMPSUݕ _l fy`5,&{gEg|qCWin5iqQfd@T]i֜kpo׺a,|><+,r)nL;x4R%%ʛYZ,|>fl)\.?<C ,{axjrBum+ܺRP ,4{Lt9EC& pX9K;mݑrOC0ҝ^ @/w=8q(P,V- @(Lr %THz* Қ8|YB# [QGoSF-[Mf.$DMC=>k+ }*~tAo>k-HJvѲc_{kʅ [J":oi#-݌ ,uUŽ*'>%aW + VA4,4^eUg0׸C_[h,{o--bxFB +iEO CPxtX)%ݙNσ{D\Vbϵzxٰ 6 V&5MW~e%f0[ܕqC [avm3`2ut91lAvɄ?ǠV4KtܽPUvV "CuU-As/ӱR-NܩJQ68endstream endobj 472 0 obj << /Filter /FlateDecode /Length 222 >> stream x]n0 yA !Uhx4qPQ(;|V4wg)lS.u@vs.1iZWm,__]_Z}˙CJhzX:Pj fpT֍GՋ> stream x}LK&]7wXkܤn7MViK%5$`6`ow|v]xKX"5˲vU4ں?&hH٤II?{y{>W!rE U[_Rq k"Qk_/+>8Ĩw2DAu鐶Ǥhk7Ⱦݻ?5dʔ͝}gLikbIF֤jWvʴ*UÊ'߳)"]ҡ>@*Hr>"GʑG1)Fn E,jD`;>+r",gׄ,ĜNV٢e2+xr~?E]={huJV.@ .} {#/0WSo,:m@g뫔X]EFFcE7z(OȎ29Gok`MyӃ5@|AyWë'8W\tvfZ`z`HB:a{;9f+Nndb? >Yu >o~/ ~GW()bfk8aŻ3`T˂EAAI΍Y-45B8}~* zvoA>1 &5+r;՞,}ù'w߮xՕs)2zn6:PN.9yS\d| ?ՅKJ{u{ܽHG#3Aʦr_YY/z5.}*Áf@D8EOOħaTz՚vwHe?44hVG7sE {K=ΠmɃ`f쇟K|xkJ[^m1iMf'1%wKBH U>&l:⣒a,wgecqJR^[H3Xo:(:a5=:jNw-h6T g?`Hc% ;‡"/~TJz'QgGCM{̷}M ; J C*bp7H;`N"!$ ;)ohTK>?oDO܍W%B#PPſ$?'M;&/f}Ǹ=>E TMxn|f&NX7 O/gOVV7(XB7hv}.._%0nWg^ x$ȅD(Vݷ7 ȷ^XL)~o>TD=hƜ;SPn:z.[?k!]Xh3Hйs}ni[*> stream xUkL[uӞ HkSl.L a"i$U.ҕ0ƥnJĴ}Bmn\d .fL4D&jF$|yOc&~y/oCia7+k= ͞V9ӤgYuT,_e)\c/.BmRKH d 0GZ%Jbۺ͢"Gtj~zj1_Ece؝D\3\9p61&^Qޮ0 ? Ztt76(Wp45-P2t:0 5`_sעIX0h|{ ОGFb(Gf:|1{k L,# a=U]t/jiqlGJ]p؀{12Ѽ(3Xh x+b.Vf*H~X'NĝR>#ȱӊ.U]Y{v4w>j;KД{qnDUUZB\_KMP?/k0o1[$,sK2 Z;=[Eu {,@\?x,7H-Jmܜ'$~F)ǿD< ׏X[l/X5$Xe::kJ6NLÁˁO.M_cychFz3&jU <46tXzt_Bc'nCnqGOEpd8<::V Dtl8$~oQendstream endobj 475 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 449 >> stream xcd`ab`ddM,M) JM/I,If!CgɏTnn? ~-[_PYQ`d`` $-*ˋ3R|ˁ y I9i i ! A Az݆*X\ZY c```b`f`XȢVi w2,'Ve3\f{<&a' EOlzZ3&vϓع$CƬڽs:wKVvr4[iݔvh}uMŌ֩U|~x7׵vWHk{{˔˺vΩ-zieonɹgϒkyO-.býw䞉=z,3wZ^ɶendstream endobj 476 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 568 >> stream xcd`ab`dd M̳uIf!CwO<<,L ݛ3#cxJs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k8 a```* f`b0a`:Lm uЖW|!.w~v? dܭ[򷹪ot=}p}7vo^}7ݕ% aY' |0}@WL`Cgw]?|ǏqߙJyVW\g |*zږts,뙴X]]%%r9kX]i몤03qmSۛI<\ϑSk[$iҺ`9M'Vwͮnn.^]pzOϢEr+W\}޲[\ojg=~ԙlqqpvpo> stream x\K۸_t 'e1dk+MUI`虱̵4RgH5I0H~~454=\5W~?7WK6-ܼrK؆YU[n2u+p]uS7JִUwoYmVQ7NxW  ^%kWX VZ}9;ѦWᒮ75j?EWIdk$֍dx'B)UOWT3hZ @b3oyR?ݚG1XQl`{ƅ÷.>pGdJ)?|$aV}w:yY]vCw,kw>a1fL^:CHc"DN~k]8xkHִ'5Anz]Hz>wQGuIoxQ6QVՍjiTCQURhM-lv򂐖DhL5=#H^PpJ~t0U}Cha\&*٨Z{8?~o|;|.ۚsПUZWхHM2AK4{ނ.^+>VXs :sJti/#t:vD\B$LS-\R0Q+1R}H-},ȹ@ vQIraa i84 HTKaMQ5hUb`{PoMAơOijۇIA 8 57^P^0{$ x l+.lkCǭ;YhHEP$lk77_uٙ5:eq@K&DtwcL%<UOyrT]r lQ%PocDTNa1Z6AS;LMرNpǙ\RiD}S}'4$ǁh~5m~-+j»1&J 9Fڥ*:=}wnqbwB g5,i< 8N+,zN+{`8$K'Jv63,[Np3-산@!V}< {'Ri9A 4g@DwOO8ygcwa#Veau oNc b[k97O'ԝ'T"#'1Ce] Ӑg00(]72㼆\׎9$Bq\^rꔢދ&cBzT;:%e@;uCLbGqDt5a^ `1eesR:!lCrBLrkJ/$ #K),L̃\&{g=J-ix /Qn 뵣rB(U[76H-*aɹjʎ!Mv`k[fj.%>-yJGS>#Mͅ 3)0lK J #b8R]2A"KQ4Z [Z _bGD3p[}{mE;\`je_VSQ.1!42YbZӚ@>Rڠnt+$n|+ 3a< :x-r9;*5heJ/L%ݮTJJNN~|[cUSjOM!peџ)KTQYvq}D_#%Q!kjp`gfw2Ƽ6 #ef %~5jp/miAvUaҔTxpab.tWt=Z?k A5rP%Y><<phޒỚ墅4JQvq1^jMC?v\/Qd tmxnU3ɛ1qAX6Y)4V9j\إnXZ>.s-&x;\F#ϣ~6`;eb5I^^fD{`k%ö-)ã6}(撓Z[i*TՆV*] BDu,/DG1jrDTp/Rq͡ L32`e\FBgKbg('?)5g#pZ_T ]΁בO"ҍ}ۧie4NA) y@t\\*׾]St& W,(r2a/\N-Qq0dTOFaB(e1.NƦ4eaWBd#2? \zHK^A 89ArXHsTV*l yGP6 @ I\fV3єqu m~Fkǜ31nbS)S"1͛[tqʸfYa[R|nԀ|*u-ϟ֞uOt2)P^Fl$$2ip`;}R?8LU~P Y-">LcsxޖRCZ3iLpyN'槖"}*ܝ~W Il cF*AHDxr6?*\au]'3ɴPIVǬXn@%K8++]/ ZY >.ݏJ 撪g}yL)WӸGr }eL ԙح{fUepo ҏ}[g ?g\=x ZFthWю.%H| =QX%JƬCU ckB5`ĉ{@RsbBXimHC[`ͧ#KOK ֯m]D[k4za h ;}y˓{n'S/ob,I?0;e^&`7NSrSJLL gY,$r1s#'@Π&xC8%&j JwZW1g>t`?[ n\V;Je񅩐kIF{* Rqtid 4 ߺ6jf"| -8d$+ҼΗ)ndn-?Y^ū~B!D"v89B_lh+7M=a^@eŒHi=@0Ԫ1TCς&q)_L,OpR> stream x]An0E7`Lh6&VU {.xH_/״l/M%BY> stream x| |SU97mo4 Ji{Z(KڴJ[EEAm(;: >eQTV23cf]qwv2]twνiRs{;wB !Fiin"=_Lp*)SvG|$ J۲{O9!.IYl)]8PדzW[KwN6vPNY!"ToǎWe # #3J( ]s-$=@}t Ƚd Gs u~Dk=&"5>)I\Rq}"kM\Be>^i4.m6}d+ާ wWWvmd_YGNXGki.gM++-mA-OZA6\bZ#k.df`)|B""b%7Ko Ho8Nr*=&Joul&Q3PAzːT$I?p9-^y ;ş,j 0 a/f[trGW"D: N>ʅԅ+u}݅r}DH::b! P-\?#?3K> 04q3)%3d5t^ҏQSɕ$ g_DzN*ِOֈ]VFW}4$w6FvAPDAAĪ ڕM*$e+ij\T ᠧh<~2! hfwwqv{L_'(5U"3qJI-stYhX͊`XxGVuf!StTT uc A/_ *Uv.l v1Le'suWxq "(J(ڜruw˝^]kFkEX #DW>*ט:Zт=~9; DxXWo+,3BoĿ,X*.br#['2C)#0W51>ؐ@Jş2'e$eS$K,\RTښ뜋Miim^PUm/*s:h79(ui2֪8[ZmmrsҰc M5 k9٩46,hp"Rg3_jp1d 5sk\bMkUJPު,l#EM MuHűB % sV\Al:[[D֌"*Dc[6بip9[ iyCk^Tkw647)s(}NC Ei7,*z&NĉCf MV{Uikq4걡Q䐨{D#gqB@ x@W97 96U61Ե6#̞u>t~ށPl.`ވ8 Er\̷R#OZrՒp}WMܖ0eͶczy@ƝHK^̀Ja9ȒI?#)W7U,8JW7. 9$f qI_dzq4 mK%`TA?썄pv,G08'j=\}XUq`TƊ\e^q}TK3SZN$ 4 :HOn)3F(PMj%%V+?ZIJߨV`$k%4k%yH]p|ZI9ZINwH9&3U.z|rI.o<%*߸dh$%r%OzrU_ rEy+TaiI$a'H'n2UIDA(7LEzGH˱e'x)uWx | T Ru"Hk9 4ÅkZl-uH/Bűy HA,NAsq,(*׽qhuQprs8G{ ^R-z3r.̣ñDLL?>lu4~8kQ_ŸNHG)7.AZ'FFC> n䬗ct}g>(QLԸ:&X{=5[ $':(g ǬŃۯkuO.uLsAr^(Ģdzv@Л@?&#`b=Dl1 9mدs:GS΅<3m8>>GCdl,VK.s.<4mh{$ ]Nmßq*.]!:ZޢQg:q='us? h2zluwD?ݼ'J2{lȾQPwc4'2Ÿu 6:ux'u<Ϻx^㍍D=2/w\>./a?,{ bmqi18lLWY+z$v/Ϩvx#FJ FtܓN'\7R 힨*'h.цVtIb$V9ta}P!ї}n1m?d^%fo3SXN=F~\tIf9b#[\)Xǵ"h-ϰb06 ag߄Zi4 9k6ýG؊Y}֮' 5*'q8ա\5p1`g툻c[y}M:Z9v#Ay.g µq}ڹM\:dqp4Khi3zɵ(9uH+#gTs(fʬRR 6.#^ ߉#Nn;N=6r\͜Ǵ8q VbvcrJv%aKH!R99tс #?6pYkt]k85|1A5\Ff C);P)sRhŭߤ[7ƏSv<m6#u<~/xXg gCܩ WP rj9lԆ!{Nt0oݹx5XwZrmb%ez3 .>-i{V]'v ;v7^}h[{'Jz=>j`Uu`p2==1.[i8.tjQPqo!kTx;W&L^hpx(# &HC!]5ro:azY=} t2T`YkhgtU?u:ӧ? yy;G<R ΃Vg1S;AEΕΕp?a\I~Jok?s%ysD͹|\I&_\)_R<ކ+h=~U?% =]t9]O]%A?S&w$OaLwIS&;;e)2\<έm;wgG6ΎΎH>Q ?;~gGz4N|Oi䉏N|g;9dg&z~4ȜsUr~+8o^55cC47ϱȅdմh),ZVarZdXv)dy *XoQtYJτgELE# RQH]-Fmb *$`dɠ$dJP1{%jbzCoO>FIpGO"OU~=N "s\b>2Rd)-Dr4yG?R$>$lcdyf3 )!)9E)rjAM^ĬW^oח_ %VSVRKH%c~G꧇̟5r~[{e4x[r*Km)iƔtdLtkryJ\ZVnLK2C:=mq~])]vKMS)ٔbS'\:!e)YJ-崤ؐSHŜ,lNR=S&U刣"o_swͦϨW]AԿg_=r8K=\Y9Ԕ mQRB͓'OVYaL.۶0PE=yVD@S^M> O>coڱyBr cQuG44GMQ?;_KivvDKb1"HP$I>x׍u(Z2wfakjsi5E3t|zly)ŐDԟlO Fl05$I>yKWK*9xte\I5el挂7ܮ>Ug~Qcg 55 wяM;XB涯V83WE%ȟ%3l6&Fi^Z'؞?fN-K$Fz:Ad|P悎a L%e#42vFezwl\ye$r_0ț:O_RyÆ(Ã$@J6!/;#EL"!it R{ L"YiF,c-wlF ]CURZ Z[v<, 9ᗋƱc.ۼw._QtiGH +t 4ݬ֚ @2ӍzHcVi"B[0T[,%Gi!ǸFG..@%"m;;@r S^37(2v} &4R2 FS 5S*cQLvC2x+Rf@YPTYZPEW+WݨXtrwEO+OeWT Z .{ 6n+Zh^Y&hiBՓ*s3,E ]~_>G|C+~1ۅDi}8v=}K_7;.l./:#d6f2O >'sLaХ*m)-)))"Q7C++v|ӳ4JFL 1mo)saNfht񩙳s3!Anbs}V^uU/-ugOꓴ|hƇؗ%y4 s"ն(؟׼D1^-FcsŨ]=Cz*ek/L<xe/靷Ɣ{Hъyѻ~\B:f501}#yW+b~nr4!0sO{Ȟ*{&!HJSq:Q6ۃtÏܴSLw7=N͏2O= [ap 1G RtYDC&"?ck` D^˩iFSْ9ڏH]d9y)c_w%aFI"$wTy˄t6-$ \KoAS$& :sO|,zH;|B0]dK"򠴍l7I#3dt iDZ-82M%3+Wﱭ4}槤Pc꛶ĉI; 3_ȹendstream endobj 480 0 obj << /Filter /FlateDecode /Length 237 >> stream x]Mn F>7hh6&FU `"/q}|Iڏ/ZUS(Xœ6UkuwO&P;ZI_=T\QscP Q:v(p0u@l::jAL`(Wvd=cu(9N(yk@a% u}8sSY ]D]jyr}endstream endobj 481 0 obj << /Filter /FlateDecode /Length1 21880 /Length 8355 >> stream x| t[յ9+YG,?d;$E);$`Ym9HkhB <~  @xfhm!y- eYDŽcsǎ$|fHsg>n0B(mGuu!>_Tx+c yϟ⿃`~?:0GXxnܯ7oG`BpAX]١G8a^98ؤ¯rp͇<}[jgþ`?_F+# By4~YmI \<܏~;Ì/Ct!c/:wmb?)zwݺz鷰7ѝ耸G<&&\| 0:(Pػoof B)oxڇ(."0މv J[XGh pIJz c,Hu6]>FDŽ \\NuW|E y@rkڃþ[1e:zZa\X?#F3o]\[-}@qz `0v\_IV3FK t3nP%^Ǜzt?C;t#X'D)[ U}+V˯uNu,Z-JkI3}bU;z\g[jyߟxX}AHcdv1AEim,m,j,dXL:}hc36 -ɃlFE, 1F-X@E1AXXXi,((FPp6ήj(H1KTpi+*tnc$9Lȳsyrfyi(OĂWaA`< I[^P$< / bcSpȷrTPX r 2 0=p|id8 w eLWcP$,U_T0 dHxLȃD&ch`1)5ɳlS-|r`\D#D0 "#;XIUI4u'BCO6[^B9>9#z9? ]H(M˃Xh |a X 4zvʉ o`<KB)@&I=(3 `-qО1d_<|@"ё`8K0~C` # DA98c?B Xo4dヾaԴl@& _H,8rbs4B*S6C@?7׃ \rUu,@}1ktP  9j&>? I~S)1pGI셇7ˡ 7LXk L.c|H,8t0Ui/İ N"cM Bx*;`f6ʠ/!1uiȣpUʙS%!Y*$<IPeJyuΥәVj$MDu|u=Ғc'όi tBϥVjJTV+Q5`ϩVVZI>ZN ΢V3hF%8!Irj|N.o<% Gs.y-V2g_2ѩ%|6%d?KD/dlUuDӒKuDՑ|.ͬ䳪Ց|.sI*|) 3>|4$ nէ\l Մ lFk4v>jDEQ D $ȏwBFK& Vj0|eԝ ܃g g@ua(!hƇ|6M0}+(@DZH,aFNϦXQҩσJ.eyz'en hsL^T߀?{ 4{c\Հ#{3%uĞ1cmXfc?lA3ϢarstJ dWmQN M>ʣ:±$~a4Ei ,1࿪3i(PIn\>xOU4Z4QEF<$4͌L2&y(ס3:l<ښfd8vBgJAdYwHd^Tn)Np^h#QHFC?aM`2N~g?ǧ$O5%-iNƝ0FxfH 35pr&|B$d52\fMI:^٢Rg:<4O~K22luO|FS8^ m L:WUJޣnTLI.&A|Fgd:S1oN|_ٜyJor%dL==Z r)6r|cБ{ ϒ#Ԙirxd:AOih&Qg`jGU+tH^c{ҩ$~35Vi2mxOU>-cі$V9 jc2(p,̫h*~Ri1!Ӊ:`t̋VA͟š u\7c+p=\n.mx8%TD Z`ۑ3mJS2TkT`_oŠ x10) .롓SX>SםaF/f7yV$LL4Ej=GVTl6jVq~D{v̲WUSnR0;P-֮:K[Cn/F+x,z8ۺ'#<~kHyX:3d&( w&Cŕ=قMܟ5{RP!i皟$Ry{ɝY5̺әk3+5 pؑ)pUmI=:toɷcOVC;QfZSUIׁTe?MQw(LJEi\j]F>IoQ~ޫT6qBL|,[2m896H2]吩wT{ q zZCNԾak@S L)R{t&*NUI/DϨ4gu$!Ϭ:]~i}%}Rg_N:amW}1}%z~W|6t%\$j%&wn|1%zjw(/D]&:˔~"Lv/D?CIܺL`%`sj Ͽ_V;=e({G3N%3O;>,:>]9:>4s$NBNtجU zpjk&Wc߳!G{]&r  {V!QFC yC!U!Qȯ__)fo~o#?{Vg ً⫯^]|gI!EM! q򒉼]|Q!2N^Fy1B{)=gB~'ȏ[ȏ3 / ٯ>O)2B|JO* JpJבPO5c qw< GB* ˤ仮|8oM"{-䞻=2HvJ=Nߩ"wiEvt|;w$Ȯo=/Rȷn['}ymVI#[- 9@nZmnR? 7 8NnHJ74Y"]_G*}.Gi%0I&lW7rm>ٖK ٢ͅdS1X@88I|Fb 0DQHX!#&~,WȐ &4Na`8_kgB祀B}$Ŀ][U%#}.ѧk^\SMWuqL֚UpUnW*d UUdBV(īt+ tuVI]Ig鰐 iWHB.'d,s͞RB<{ISc4NKIK\ K]{q)dbI.'*4(~I#+dQYJ ] Y@8}Nعs'7/کAW޽j.]l4*AW+ԍ 75*_&]uu< ^䰢obC( D'FQ`j#ryaH:$YYٹG_y.B5`̃V&U^z)qtclxBF2rlq!v]9.ڋzq7kܰzbϳ= řUWοGrr-˫}{O|*8AdOSf6āGH-^cZ-η/mN9 ̖Rr۵H()mt<@1^'dI ' *HIj eAPDBdHdAuػ(X>SPn4X#k*bǚf,|WseWyg{}7#}>Վk[GM6~g_&\3JKER~A~TrsvVI4PQ**+e.UV̾@3 UReeE(?[hV>8(U{iQ69 heErO˭gb]W]zy=)zKi/˘ r8,Eg[, -&KlɱX,֚p) -ZSEIy#Iz d]Ej0KlE'V r^OxSXֶ%O}Mkz72[l{Q1ky^`lr@9LM:I h ƨD5aÃl%ZM:"8gW|l .&vf3X%].y Rۉk-N싸Ce'`25# 7k,ĉg 4?qp'=}7VCʕ ۵H Il6Q*a!`$TC(*l1K Ffj-T+&t>[Jee:4pꓙ:N> Te\Eyyw.yʷ׊eSx:}_,}W ̲pbvT 3^cU*/3 Apg :d4-9 ْdl0Pl»t֊;̂e*.P2 s*؜8 C,&soQ*DA,<|MW*;){V?ٲgײ%F?~m%*D+QsyZ _vkZí?.,+cJbnjP?Dt,55R~~>0OL+y #0[( 0"Ffٙ~&O?@LLZS~edFCDDIM- > stream x]=n0 FwB70.ɒAD" 31źC'Yss/i^uQEs ˳xL_ӻ?(~uwj>OF葝ҍ1]^&G yܴEaP۲(ر(سZ`5tz@ա6N(+r>Jkm%Ή~H^2O }endstream endobj 483 0 obj << /Filter /FlateDecode /Length1 20884 /Length 7816 >> stream x| |TwwfrɃWHr!2$1H2dB2N[#Hfƙ " @"eբbHk]dߺݮM-n7e;(>03|}w !d h﨩# ~1~RϏpp}u^Bxݽ*|-dLU['\=8SMƯ![/}gbOy!{ Ec/b9H_Fx?%D!r/d7g;pe/l%"wµ} y!_ 2W yCYE#\7_&p)Srq?|RJ7Il8&4 9M8;HeC;cd#Rf~#ĕSA|p{;}N ^GN?/ߌ:)< D|5iub%gf"t B5{}%g%UD3:?e;? troN}1i(πΈ2-S%B G M(5!!Ch#y"`DLL^qQt3ʎb1,B;A@+ ܲ2 z;jʙJʫWvG!O$o 1ʏ?ЋFA1rG@W1NŒC ` 0=^@ !3}QUhO1}>*$cNa4kB9C; tYC2hT1IU#4Ѓuj$}7$GCf9ߵ*?ԋF#Z/I.D 1 T/b $ *J8qJ]>MkF;MP"""qŖc> UL7`qo^&:H tj!n"q~c)Q` s@;# n)n.Qq">Z1X:RERÇ>狰C7*'ⰜҎoH4l˙2Zt0(~P F1]>ʎ@J{Q z]һrЫ1dUb̩^ΪP/jf6j$KJ0sw`D]9U)LXȢOZl\rG{kiپdk˭8/7+]2B8mr{lm[-/5e*!;e2G݆kMϵV2 Q A-9`oVf q"sN*;Nqy);;ņ8mىTll("jlwv[xȅf6ٖYK2"kG2F.l[Aw, vWi.T;-mlRs&&7PkCM Eilڗ&2k 'N$!-6j;F;N[AQmq$6FF ťx\NWY:"vdڳyr'5^/];lY[ae4X.۝_8F}[ n554N3Z5 1p56k #:jvK^:6n] $B4 , wu"1t)i$|'j37Rv7Kd5+;)sw$6e}Lp-sP _Ö㩇4fufwZ*5T63BAv>EJ!Xc4/p3% gq1֟< =Bc^y3ѳ^e|y[ObQAcXbl'?zH1I W~J1fQE v:΍Icօ1Ґ.CE9gXT 0aY'iJ!*Lqjk)%Drrְ "3j<VӭyS '<:Jz]R+?AMB_ E/4jb-Bx>&n?ǽZf[h{z.;7b ̐Aj.JjLD 4x$5RLf7\b9Tmw2 [Nl~Jlc79ݚDiY ݢR:3'2?$VTNN)6O f7b^6y^mtݫ*xu3Q}7Nc~V8&AFWA:7f^v.pl.%ayJo|%x=|Z1)T^v|W$(w0[-3]b"8޸0 oic9(408Eք9SEF9obL#JǖjCJPha٘ZtцĊv&kkOhH-{Ri>eeKi%?)jݘ4q1ʮqŢAY;1w%sr?7Gq+*8t 61j8HhC.W]6<9'7wj՘FSNsJM,`%Wէ%J>n=aǟZ>^&5wDUj MT%!VMawJ{Σ7'h$.tjRKPEOav߫T8U&T~ ~ps qme!Uf,`d7BeIP }1VOzVOvS82]KDQW'u}OS?HJ>~4n?HA+yO O^G:uXO$_W_)0+Ii7'WyZ4qJI>t~Wȇ+%WWJ[z_R糧KZI|ںKI.xKe+he]\|]&SetϺgI]&c2I$d]&`b]¸Umw$kOw$];?ޑtQ;ޏwϬQ.HWI\ώtMٮ#t|.wE-$i:檆e~jo^V5U5k3Yf drF +Ou_x_ g%!cT﵊WA ¿¿)zxWwNw i<oF|{~So)kެ._ ?))#9uH"A{(p~h =h [|S̆oo ׿#~}|-: _v\#zvmv~RܹvZ/W j>T Za='v/lCMm&? |nE6آf,j&ش FW>́,X/AQBd! :֚ĵPgtįOpC(|. ( ܮUzVIrdqeP`9R^Bb$pmKpdBmˌbˌЪRYQ\lnТ@ IF~8 ρu)XXo-,? d -raA6+0_[¼Fq^̝)5œLfgCMb7eBmMX 5P=+C6¬ 0+ř^*O`JqW P P<Pβ f^ 5'^_ym6Tf,3r. EQ9CDWE8Kaёe p9Q':Axq=ǓiBxnn>8;2q~ҎUzwzA[]rs8I0*"g(_;l3706^x[%l+L\91#<9Q7c:\1dob3 `(݀d_ym4ל8}K37ϛ_k זԖʵe勦[-%Rl);%R(s;o-^tlk{^???YY)wK¥a9\dKyK٤5\WX0avpLsr'Đ륎Ғ)T($۸BMp%uFYZ'"CPPnagۖ:*s}=O3fO#rIbKey9s O:#gQ{軅#TVXf*+~: pK?#۷c%h{?;wrbmk"]8tbhΣ6Ch=v>4UЯ O%vLJnͯ L'?$t>"wһHo2Yd)BGٖ}D}f"}^6Y\`bӒ;.Gr _C{0>I{T-Pe)ѱQ7dHY9=B-Pɹp9s}1 @2z$Y$]"S3Oϐ38Sį;L%rTIBPAtO^П$G> #1k}weIJ9HRV1jS8Aendstream endobj 484 0 obj << /BBox [ 1615.86 6196.34 4450.7 7330.27 ] /Filter /FlateDecode /FormType 1 /Group 236 0 R /Matrix [ 1 0 0 1 0 0 ] /Resources << /Font << /R249 237 0 R /R251 239 0 R /R253 241 0 R >> >> /Subtype /Form /Type /XObject /Length 830 >> stream xVɎ7EMn&ad 0=rsds%uSň:zz%}nt"fӽ~訷_] .>PR<# Hbsӽ{dyBw7ǎvכmUҫ^w8f)!Gz1|7NQI\Qq7q`PJ0`)ł}JNfK(:<"ê*xx<,-HÓQ,p5ҟoKfTKQRA.%; g$pgZ49-<ӡ/n!L}AO^䴇#PF9׷chluί_ƙ!XLA#%hK2t`_,5 %T#9D?0oFnZ#a˂ƨ2 >BtU(n%:s2s\TT/fA&`L9,^ǁw=X!b0#޶FEWU >$m(z09ֳ  d~0yʛV/ykЪo\jʑ)ƌYd:L5= %=O̳bνlj) C¾;|D9`F>n>Y\,̠/äVqd..jR*T}5 0{{@9KTa~&Y<2Tlގd&Ȟt_H.ϳVf(nendstream endobj 485 0 obj << /Filter /FlateDecode /Length 523 >> stream x]n@w?dТht 4Dgۗ( yfc 꽙ecjs;8O֯ӷ~g ou۳>:>^nc}_nZwá\2o\ϣ-Rcy=Hv8pݱHGڶH|Z`֋Q$ؠ"&H's`ϰ         }`{k`C`ZlLشqg_5sv s:p.@'E$rиDW3(bhPP0( BBA%K2C@f(7X1dp%Kf M.0[htB .8]&D$J̖.9]&E$JФD Q(A"J%hRDIM(II%4)"> stream xYˎ_Ȧw`)p [!3L)Edٖ؂qNփbVf^^Tt?_N??NeTqa;]vBNVe1||uJlrۛ# *e?KF}ɩ#=hٟܽӗ/NojN6QmĬ߂-FŰ]mn7 ݖ%X9d̅">99=&J&Ob>{$A_ѿ}{j|5B a x\*Os8m Q;U.ڤ?K;=*S0*೉؁px6Y9duDQ!bdaT0Ց4\Ց]Vzb=ﳠ)P,X;"E%L:O`I ʈCnډψǻ|xy\~%1e\4c*bPP Ӂ'̩d$P0f`D2d(Lt#؉^7 gQ, `r`ɻN@ʉCn뀎`L" Tf?d3)~,["ZfҮ$tkC ǘK^X|rA# T2Ah2 `'Nvk52G bu4a~ * ;A RÐ:!FiDb0CfY$`4@1~tiW{(Q"4lD[?m4F`/Y+{jHW$ЀQH vka'i QN5ɢ"!Xֹwv~1A/Z7m=1^lm~쟭d0&as r4%n__1yW7T29岝:k4"_ڹnm\Svn !1";$oЇX!1,ңKՑУD+YYXEuՑwn.wX[F )֐\|) d9 M9q<zêY&z3>7V.60qSGOlweCÐٷyMFg6eps;MҨ3[f,ϊ9N ,7bzɮ clɳbN{8jYI> xMP%At_2z#ST^(hb7@|4cS@i@wa0`eqvNE EG,dIdgP7rQr^~v  M3KְbCƥEf"S=M U _/f4J.AX8Yj`٠@Ymj(m4FZ%kX4M㪄޻5SQ]*$Ym M@20v0IeL)'iU@94I&:\APYGO g n.v7ɸhR e# ;sGo|{Nm٦s^VVMۤ4L٠ldd& %kX㐭Xh=!Zm!˳X Cn6fiZ=m4y^v gq [#3QŨQiL!¬)Ng[׀Q <7@@`gpYkU$ND0;@ avt}KK݅A=rA#, p. M3Kְ^VdCR[ezz͎L_ jéfF0]94F3Kְ!B3ЫH؂ e\SXWhaƼ YdsB\w0yEZOb͊H")PGZyΚuVԿsVpf5r:k"tk U9o2Yq˙0 B_R0R`$dT!hS{RHݘ?y*З8]Nve?wpnd?tf^?ot4?k7f_ſ}v~>}hlԁheW_7endstream endobj 487 0 obj << /Filter /FlateDecode /Length 3261 >> stream xZoF{r]."!M[[EX73KqI*iP!;;l>,X owglqwӷnK+b̋ m^HX2n_a3b+r' 7gd˙vu]_G](粻JJE5-.y  Ͼo6U)b\f+-r\Ν1^o~9c&ku6 mŠŊ\Bx!qw˕e2g\l,n.<;s~..o6ۏUUn&Y+ߢȝ-v߁ ,֙UwQ:%h݌#1cx"6ۺQnWL27uSn*)U/WN:LĞ}3x"6]U W97h7SXrcdIF)+3̛C<dKhONdJP9%+qptFa܀BDh &{ m.^TZn߇3I*x>L &?Y $tȎTKlW!0C凇6I*OH<Atl14\/qwKAQkuPa1o0!8\z6WE}Aaubv(4yֳnn1 nכ:;Tmw~|nD\WG_Nv"$^IW@qRiq-*p˼,rv`:{JE,$s$l\<umi\_/sc8^:8Aa*UdvTVJ3 Ma`7 8-]\C+FAO0 AN0NձZ 8RJ;eX~莻e4*0 +'j$j WFhvM0LyMծ^gH䑂FX0~VBm7 } q;qCz^)Uxz$:EJm++$T=uA;ܸ{QnN9 xMzp3e"N N4v_\UF .c::O6b5??a.73z+L7"WJ%pcE 6jbCA,wÌ1 R Fa%M v!\ae13A +32@c8臻d pR |#Sid&ra,U]1fPCX[O@<#3z`I0d;t Ai EL*0$TI3 My{~PzQ?hLI\ʄ3*#.;-rR,aSC`qMhS:Obn;<Ɠt,jiBv:.g).mss6Σ܌ 9 ?O Y0ǤӪ#k``рI 40$w].FT NSh{4=NoHgT3Rj;2t\YBn*6p7H{OI/ pV޺LQRoD&j7e.57EG^$*!)pKIS(q /+je]Q ]*Y2 q+ Pc7hv~dSw@L?!!(!&]pZ&z7 ЍͮGuȤ:9vZ9Ohz<_)Pgo/ff+^wςp*d}hW}?FTr8ERb1 P*QLgLVPNZ/k im w?=Nm6#soOUznsİi>6`IxOއ0 '|njMol) #挢1Y͜ gNxdڽ <#Jj;Óv {?<~86y(=dyYD5 c٪vڳ[.$@)BU "Tam~~"&YY;wPQ)<ƾfqGr}֋Kߝ29f\%Ffі'>ҡl'O2Z%X$-v -8:z"VagFt(%Kzu>f>.}u%q5Pz=cvs~qEnGoΊ@=kj__jphAMʹp<* f '>ٷP6S*<+ZH}5RAz2Rr\\0m;X=)G.gtg緸N1F4/źM⽰,&OL]EB? Qzt Ql g52 \,q7󪲉WRTQB QOG;j2FK(5Q%Y߸K!'/q(m#66Eo n<ژMK_s do.)'F674wrɄl'0}A QO HzF|Nbw;;I N*1~ nLMG}Nr:"C:%62N?t0 dwݎc?I^^J D\3 A[H,%r#ğR"}U_G!<__z{~qyuWTX`Evo?lͯ*іuX^6r"q.l{-UW A/ŏg+5tendstream endobj 488 0 obj << /Filter /FlateDecode /Length 3793 >> stream x[Y6~߰<ӊx9M   gm%nG=[UnXÁDz 3"%APa 0 8.R\"+ U$UZ%FîaDf1/xMmkW5qff9%-\P:&q!ɆRmbԇd DSPL s34c뙕&}si+j}4L? ]Vz|,<<%~8 JG( ƾ , t+˰.'"*UnugdeS-9.KƄeu PJd>Y؞s-E+CYkis!2AYr!}hW$k7m#{|R&ڗ=o (]H#YqJK 6Nd* ϛ4Uq}>UKZ 'pˢ0w@Ls3sTY JIA,Z1imxeO.~qy;}7&Ie8'u\M\2C,SH+)1C=N@i\uehFfg}`O 5v h?̮, 6S C#E *ݿ=v>Sm(ߖ_QI{d/$ *}(E ֈ#P߻嬟DV-D2tq8Em_%%_2ǜ,T * )RcwlKi.BDהyͮv1 Sj5ĵ٠({`hiyM!Ӫ%ҾOz5G혈;ltJw枟 gu2:7>"Lبw I@Lo?GhHm&Ej0TUE!i/.aj H KDtgS"2Z[mΕe.kYv:9@YvC7и f݆;+Ҡo~).£65OswXrZ%4̠x5E-YpMYgg ŬuEӫk@b`Ug(\QP|] Zs<;gڞ7TDX s'[6:2{bEAXR[!u#/opa'nw]h)_?}$\Y3]AJ @h Rd|>|#m e!{hQm(T/nB:Z~ha OO<[X ƭu➋C6&2O b izlE8?=\لi왯HTU惰2@Y8*1sAh reuPÖ0ep]OȴiNBb?)%|Ji 50vyUō)q6b{Wk;%RM3]1XB4R8F/깩Cݵ#dB`2\]oAW})x}љR[j&'eitKCrĒ"؅.5e> stream x} &E/r4, oά*D@@EvTFif>{{P@PXğ!">EewsED\@De.z̪ʈp[gddddddFF}gp4+lf$]1rH͌41\_E8:qiyϓb4K~3#'^7X6U[94 MN0Wyozl<~Ľ')lQN#(-I?{]E}>;0ZTL/ &WiIR0(Iz cox DT'qaX>ҋⱉF^=1r44ޱMSQIU2IѹFW<`\x0Fs$C7KGhKhG}h"̋uVA#"b?tQ 0* ~wsÏOL&L~1b:84T8YegU)oتeQ?jт:q. !-fD@E?(:@YK{*X]RJeYY˫EYj1RJ,UDf,Li?.:<]?n F]&N?\wM~  콓S5y5EA!xE@-ⰯH{TtEK; {&"E4T2o))Cl߶)n ,7 aѴN qRIJ`İ:u*H`%unZLEVձNUjuB%XkF¢Q{PaZH$GL O[BxZ_3cD!in!,rϓ2bcX]&&: S؄MB!q&Q}BE%D5%^fR;8!uZ‰m 8QtnX–ւtr#A#th2yZY~MNAߧ O`➶_Xj'AO V^6 w_h' "E:JC SAz=Jb&9 .C0Q .8N m Bv9'%ˋLF̡M&o,'#n4Fe0ffnG2\%Qm0ׂ~KѼWِL#M--IR'ɚZbf=5Ogr)uKRZY=N4:h*u$V;vɚ)i&v>ۃC\iz֧XܱSm9oHRBS>d #cO򸞖yFpDBCI6'I$hrwUNSG)d|=wD?RiwI}@J:&Y%g~4q h,5ʉ&Äsۛs#`M$==h#.nw~na ,U9-mr]}PI !phzw4eWt$< 䲧'gڌs*ڏpHR`8I!i衦f}+})t\4 ⨒|ijRDFUnIR킑,t}7X_xјB{ڢ]+~RӾ.XT肤=-=y%IM{O!>7$jOC}3^˝8Xrib{8gAݭSNYv7s$=PG9ιѴ}\p&Ї3PUhV5`Yf&ՇsI4>}{//]wO}ݐߛ!ҞXېd߇d=-u*"GFK}ߴ˫ YW1jגVTKE)k(֗.e;贺2wyB#PupThP,Mz+STY9R$P*K*TzvrQYZΔOh唪\EHrB5@6[m}W7b$P++F)BMhB譥[qqEH5rBݮWXRRu?W5*~%%9`q]H⺐ʇ rwb0@XzYz,٨D4S,V )V)&(WBٗ[fzUV u*X,\\cw_5*ٓ UҖ#V>Yۇ#=oKUϭz+X,̪X\agYp ڗE&yӺ;jA*A({KkL{(T=-$O jjPNO;V kj(][nrյN[5ׂN #W\믣]R?]5j=U+(ۓK 5ٲrv˒ʴ tn(jnѫH[:[P-F_o_ parixҐ%QpqrqqeH%nrqRsYT\TP.mGRcBoRzօUZ0bѺꤚu1؅ řKۅ-WUCƴSU;S4_5};BQ?]Nw1 EkP/-rBw9U~j^ /kA(. FLD*EJVT/F*ʯ1B,P/6L_fJ֢j'wT }IRDƈMb|RxYmIMؖb=~ybS>(-z|nS7 ,i^KR(ѷ cI%xR E$[XO/͎\PlKނy %{[WT:oARdYr`4R|GBA\BU`6=7e{% ${MR(}ARIe2wAR 5ՂZuIRj+>v I\Hfrz%m(Tr*}tԮ{m[랜m)׮kU\*[а5궥\n]5;j[u(TK%d(V} (vO.ƶڋ,HcU!ֱKumvԱ{:vK֥%xu j-H,O-HD(WKS&W&]BR!GuU ŠRBu ٮ:5*NI钑I} 5HX66]dvvi k%#հ˻\.ͬ\.)V*E/ UÔJ-H(w ]Z~be(P.{?]RX.J*VK$U[X.\bw ݥQXB1mA5y=r@vC8oڛ*ЛsN>PyQ(*$"-AiD@Ό9Ci%QM^gH4& Ù`A\qPZJEP,+A " ?wSir2/8J ʡ1TOT&SjJ(+ ^պŔ$m9L]ڏ3!iOʇoҙy0gE_yA Fhbyi_iI24j#vJiqA,t@F8@M`4p" g2B WiTW;y*iWy1O{O2ehzr`KhC5y&9Ь] ӏjE.4PcJba݇HEQqC0N$b>'wU҈HĵG"(C#|&$Eg$)#p %QyAEJnÏjv9 M# Ν?4򂚬 |$4 WP(](C#䕦{08{aCN(/#|5QVKAS2r?̋j*S(2rQ1G9iJ 24b>G>(:4ŠTv G FJ+պ(lF}?'I|G1% 1`mO$ci<8 lƔ4ęL!GZyԅяj1СiT8#yB ͚^:4ŠTTWqiQ ^WS*i8c? M <QM^9{ڡ+(Cӫ=ՆE5ya_9(CszL%4!zA Vu%!RM!,G( kyFd" =0МFXyA VF $3~,CP%<++0 $(*2F#GFvϕ]Oz P%<қ^24+݀ǜ>a42>PUDh Ue\%Y I))ID&WnDqC%aաY>K`4Š) Pg|^1@j#rPFXyA VF ̇8fE94όF򂚬(+΂N}sa4oIpiTW( vEtC#qOWp^?{QM^ML:4m}O{T)>((C#C<'~+r$npm  UH8AQ֣`N=V%e,+? rPFX뛩efx)B*)W9\4: *Nl 7ZP iRPY?r0D@])|40 >tӴ~+c,JmH8ʡ1TAi jAaE@P.O$!@2Üte1^S);q {_l94J[//et_Iӆ`Q=0g'TlwXN(@8cP98@zy{PA208(ΟKHF# j*TNb E94 2F򂚬zwsh1Rym6Ͳ򂚬CӨ}1TDrŊⴶ@FHA=24Ȯ(V,N\>R y |n MJ;EqĖQ \:w9=&%C#bxA5qFPWS}+/*o" gۡ,p[h;W?| xYAT*i iѬ(1KD44e%DƙN.-$3a$?ƙD6yA V(;4ŠxG?624J1TV'^OuP?1v!t<o3CA\@&2M)3a5Xq@O&A94R$iT,aΒUFXsOI#~/ 24KWsOz̔uh$'#=V,bi>rPV^`E5yarPVxi!IlpZE5y'<0OzT+ F.yR24JAFN](*f<&h+r&Nb%GZmTW0Ø|+/*jeh9 -Qri`eѧ3CFDjB<\F8R224j* v3EhZN01TP//V!Tm(W=P*iIeQßKu@SF#IdOؗͲ¨o84Š(AE𣚼R{#ЈX B(]BG5yȁшX سޡV^PUL&0Zu:K\1T@J=5Y^FYi(m>FQ~P? v*eh;CqGU9!@~]Q nQVMچj*l8fb Ξu7F#shoèL40)tIU-o?S-Ѓi\S8+\V)+FPAց:Ĭwt,JaAjc?bSpV͢+WR=TQ]EɬRp WK(;+Ρ-zt?[ڛ\:VOa_>%Tt⃏]|a,> F>,>hC:=%xٹ06kfVϛٹxG8dt3G`}֏={Q7`Ow垭|#{^\mu ߑ;W>O=8/cF^}Ѿ~D8}{`2]}[LU1FS%5,(PPɜHw]N^WƇS_Z~|H/ Lcj-ŘTņ$>`-$iqǭZy~ؐ.߿˾ngk/zѻ>whKv՗D|pQS~ԷqQ?w_<^gYuw۹g3_|Ï\^ oyiѝ]?p'3wzE?jak_t'wןw+eWS9 y6;'/ߺxכյ?;e̯?f|肝bO ן a巿ۨEl[~Wp{#t'n=͛g>>~[^>_mu:p;{_&w-z>xKo좣p'Gםw}[sM7>[so?>{f_ߡz>r}m)5_~E붹_<zچ7])[¶={䪽7wyG7^~v%3x/|Ο~UǞxCmm3ݗK{z{=olq{|i_x/t7âv;{OӇ_-Nӡ97}7W?{7gǽ{Gy·<+˶M'~<*^,K@C cXU/RS'xp"8h40*{\oHEdt3tIcs|1y |YTga~rF;U8h~p6͙| SQ w`ɤƘ CEtc3Ac6ƛffj gfduxlO)e c~an )QF60"k UbQ9ޗZ,WU?q};/FJaV)zcJ@%1/;ȵT[មi3rW܊F]u<;_gVMryuFvkE4vO;\ylM a=DQQ >*M}2'y#楿3%ƴ/$u:>Cj3<1NsIo[N-'l#)5iT^Y1i%5gdyHBU27öCdеYr.O͉qH4m8  &%^Tm)Rb̰G0-˜avV^.ex6]/tqWtڴn,ꭥ+}`bDn޺̗- sZ]~mD{es+,9:њ36x#ymՖBR)U`q '+uv~~@:D@Pyh0rA-9J, AU686,fi{eV lu!uv̍^Ա\C6=DRwzMrY̟dx:VQak.NoztSm:haܺckQup=Sظd<>^9KqB8MRVQn<TP!_S qr?1VT#wT6ma'BsAwjR' ExyanzڷKF^%=v56E,Qb^MM:k~vM(e%jw5[ |AWTWEڲ%Yܛ8TsGYg68hvIӱۑgafRjڇG97HEz\TbڰH73VRq&( :B as!X;_-I{'jyZc@5g lyOdG:ﴙ5ax$6]ّin*ռ7@!DRMnB, y虾+{l 4dG4'f>13^]̝PEy,v?9epbtd*}jmNꫪ@LuՍܻۤT{sEx_TB0;{;nڿ{&>8RkD gA;RڜmOV;$T#NB9bn0u%33h Z0hba^b(P3?Ͼ(Vyd;ޡcydsYO43|ܗҨЗm59hsCD#ϚHg},vP?^rT:<+RHze&LKQmpMLxيɤ, hM ;x,Ժ*J;nc:orq#ezȫ ƁSY6_đvKq՘=]:l6CWsʌqUSyrr&4AYZW}&uT:Y;IFxU L\%s"d`CLJq*5./5a45az`!r9M1|ު^v1DI?:1pj^{v/)y97x\]嫮ω>ML~YK;pqE-p!Ϊ71I?V?aYq<0A+ʴhO%2/S`|4aeu(@❱~B7:άSJ oߙ*<[oO-T\ƺ˦,Z^Asm=f cҪS2tH$)Jd`Oz[0 SՏN)%g/rhwsSNM^n-s)D CD8%R,LV;J8Ag J> stream x\[6~0~h%: F.#nsd؇x(lISU$%Ӷ >U$u7M-./{sh./\zz9]>ԾED\:qٚ\^.*ie[Y;iۋ;\5ucpU?ڹp_cՊW|̄T+(6x*JY'N*mhU cuckܴU㴯|WwyM5v3݇R\v\,)k8Hz7}oY}߿>`+B}w}1r\MQ@6I]ZԖHsF,SMq;^W]d. /0V4TH*W&XRRѢ2(TO0׺zw0ng hW$P\xsOf8rIFx܎(s9|@snHի>\ia+_..wn^"1z}}[=Bٸ0΢I08%ybܠx5tu*P>s?tJkAdlHeku?eׅs @2li5 $ѫՊSn6 _|PŌ2Z-"K ;*煙{q\_|Q:ò#13r4te^% Of0X Pugs" ~kSƠ"5)oZw1Jiبx< 9kS7NihlnCOAV'R}I\ǃ"k'9R}ڜ֜Mcapk6- ӓ+-n]Y3;c]S.>!_i,y6YoLЋh gAy5z 0ja'S$境RB1 R¡ݕ^@\t@@S-YE`j[hP4CܜJU AQwJi{Ah;Ln$]lV2w97>{ZA]v0ق4 Ј%\SӎwX[ֹ_DO$ ֠/ Z=RfT4{)2,4o a;gPO(mni[wTe.Ne b U>\- {ZH5@卤mڝC}S =%I]ݠD90 -Q g|tG@2t|n?'4/АȻz4YB@錻oys=3GԸR8Wm&b\BqǯW.tg[TRAI'^{0V}H(,ȃcIMhnIJ ӬvaS;'B;#qs\O@*tpdLJnj P*MdPh-:4Q@;A 7R?= 5 nŜ[ɢXR a\V*vy/ ,1%%[XcJFMLdU03ftrF%,1Iɣ<1kq&*2 )4KHG(ÓSV]BqfQ2W3l Wvނ >})#1.UMm^"S[8iV<7`3!$GG@n F۔Ee'4d3Nj068* TTm;{TOeHM*/lֈQ&ۃor]8 2Jr\G ˡ3̓cN'ea[#l%njY|e%AN|nۻqC=U P`ڭh]4rK{Y8vu,{J=(BQ4f"^l]Q-79gtdoh׃{c@]g$ . &e)lQ'[~Q?,T4h\ajf%6 >q9bX,iGWFt%]#$JcDQLaH(ĎŹ&g6徍RHJEQڷD!Zra*#W]㷔A5ZQЍs;GzJ)^19p'@vҌer_ 'MB%3բg=HAhu"K8MJ8$^hTT0/I"s) |Dҙ"&SNp%F[M6m6cg!_De7#2n@-F՚]I@EE7$QAQ0jlD鴲SG;Nq+8T=0cd&9> PyFȌpG2F{X ĝ#?Ep7Zg,7|~s8im&FZ)A*t*L [s۶)@?jp:d|~<(L)ekPAk+#|I{ȺAc ̑dhsq-)ϗ2(wLD~Fv>Iu=-Ycg-bKQzz: Qиu6lQF YȲcr͜dC2gW|ܻM^,[~a<^}_cBSbBXr?\"^ SD1-z\?MX7M]E=J{R1oC/j[fC.pkKRci sKmRJ(8DP"nn@=čCS#w: qyB/coQXl gniDIS@DmTuy?vԽޥ0(C5uI)]Z y׏ C4p| ؇^,K/r#<ˆqs*pܱHH_8xMzSl!Px/#e(-y9,d*: %)$0\QH͜v Ta8ѡā]u ͉8 Ǹ_4yE C?m4w6K%hHb4-a&\i Jt [?_,ntqIjR4]Y6WqM?g%gĆtA,|֍ge#7r[{ni | @!c;4!diXWrt{-x?-+ą#uyB(ECDЊ p@_Sud0V1"{d VmK('U#ow&3>Bh=/67DMgK4\u -R}=[sj֭:u-C=Bk9'="KVMlF6g8%("Y}5} 2{%-`%NEg+#'Ē딚}]X`Y]>zQwFV>TQ sKw76t\\jb֓޿!/Nb=ŵƀi[SJP>ט^l6V06q1i}@`ƈ4:̞Bv79^*a$QhwW;\٦+Aթ ;۶<,h 3)sa4|W: Cn~9ܦ6w_=nyl챟f,GN-y~26?=&R򻭵{E:UZM4JUFxoeF.3ql.*hG-]F\ ~W`؜z< m}(O}XWtJD܆,3Im8tT^-d˝MR. )9ޞ1%|1 CK!vYGMaʖ!0z?BZǵ.y奻!j!cs~/Ezqjh@t=(Ee2݀nw\K8s:xC :*Rd J|Sy݉ՐbuX^\,*> stream x\ݏƑ9 0p^ÈaI$sÎ#Yf" wIw}?ݤҎ0U侽Jv[?pSn0zz<nwj|R6UnSحaFM0dpK5Lܼ.خUY)Ì6=j1nMSOEͪHnj8HYaJvVkOZhm紊4xZJVǡsk6-FIUŋc5uqh?txY"y ϋCBm;F a,FIc7@gƓџ5W.)CnŁ4R 4%s7EbS٧`@~ϸce1z*D1*!yi䩥+@xoeNioyqFq &WČd&Vf.ò.owvOtL7V'ZD^W` Z)#PҪK*kਪ*?$ ,PW01 6r*+7f*98h5vg' Rbb9xsn4~ęۈ6*|Xc DO-(b"Au-H22%GG*Z7v@KSiGHB< j@&S 7 /b[ `eI)PtOp> "e&*vn~Ec7b윊 nMb<K؇lxjG=,˙FФ6|]?,HxD„Vejp1Nh4l_cihc^-Uw=@C̲ø(&R١nf1o[: 4rFI@z,{8ܜ̭xn؛m tHV"5鿖p^R?1};)7ʵR# xAH~C|#PjΖrҜzjXBdha?qX@hP^BdY!À?zwB'5P-WB!tBo `=plzT?sy]%/묧# ]z-LW"&I{wTp>a&Csj];c uv!A"P s\qBV%4=*6ahxsY:h&Q⬈ mE^2oA=O6F0I~, 0PΊ%Ѩ0;h~8&ez.ђn"O-ר$H;@uK)>ڠ3d>h.xG!TW ܘM 86v{ӳ6~6z^dJ')i'K~> .)QDnU,xr̔q">!MM nm9,R^)M݇b!9WWKP"!)V=8NjJK18(b2HYzn(fIms]}}׋i73BfȹDZup;)Gǐ"t}Lh e%(R;~'wq 2{)E#TzW.#ޡ/R,E˓(N$O<̍X#+~ku6F])F-|%acU &'P3> `~" bts2SYdb:q{J{+E m&h uUq;t;4F\ ;%Z)gDcGHMj24XkHKZJWp`#W7] aRѴ\2I֌rH51{c**8|>},_d5bZZBa GQ2!&e–,ȵZ:pݒ(#vk(} r~^SE'@IjaZ!ڠףiѻ)K7OQXȲJ?9y(v|OiP˙,ԞmODK ɫV.}Z}_;EK %xrYs[1R&ZAt߂)SvNr09}>.% I0]iH|ڒiLbi^^%ɪb2.S*J׳Sl%Xx~:|Rө1Ko V:<8~X)3dY2RdaKz0fגR JP7j{5Hy?kʫS\%2֚[oƵ;n]0mE~,em?% ei=]62kB`<JI(H:`,"ڭP_]syutQgdԯ.Y.,Y.y7Utq!P9 D!ڷTE0:Ji,$ |1p#`MY%}RSCXZLkju]5!pivSm<XYY21 U£(g?a< 8qRkh1"Y׼gC j'(Bɫ>(GЖSFYf,阐<VZ0QX܅BCE憂,^iw~ӫBĖhqUz)tKHbOMsQ\a{RyS #΅؍#͟Xճ&*rZ<꾞gUKz͹GdN#JZd6.Zm>Un߉0 ,ҿ@Sj6酦GwC7N ]!MR:ؔ^WwX 7 `j! $)X ߮gP&bOпVO7]:Z?wokavf Ӄ-,D#}\,AIa0E4܎И|1Q8 A)9FΒEqݥMSK,G)/iK{3C8८Q,Pk$-+k flKtZ;MQ,0Fbq%S'ꟸyo0*>rޚꬡ)O \PF u w'!mr]!&! >PpQBܙl^ƞV1vŝ,b:2Omt/uU[oS/u0)CP9ߎjq845]x-oH*vg6GX::`@ >67,#)4g|}T'Xt^΍63W[Y^FStAo(:P5&3)L+'BۍмT xQjyMJBro endstream endobj 492 0 obj << /Filter /FlateDecode /Length 2536 >> stream xY͏GWD !̡kNOwWvb+Yʮg13 q@RĉKNpI.(r4c7 !dYSޫW{U?N ϓ<=L'،ݟ՛}}>3};?| |OW8SN$OW^W"9p,"5,uhN|~D0X:"y~$*`Bv :a+Bn$b0F H$WJõHJ/5ZegzW'eX_Reڳ"S.3̠l(!>ևX>z#z{lu+CL{CdvWuzeUP%3.Y+UL*SR`R |RN烞4WpY9a4/ dzjqB!x)O-^*/Kt릫* u)T\ R.ˬ$bcitZD0. TY{j:@1i@^Oo'$LUeKi7xVyނY<\NŹRfs~)Lyz,֙d(0 vsAVNsR <דI 4)!9HZZcfgWˇĘz~'&Y)99Z?4M9%D޳a$`BQ&j>`pq`6*pni`Y zcm%ELQ`ވ, Bh,h[u﯅q4+#A/!֣l+@Y hMWHB2 E(7 f:85y @rw )tA*۳g#ķ&C6Šwf~O1/nbBt p֝,/[<}bx+A#α+pY8QMtc?'@:AWfrgz/&ܘ= +A9Gc Gnw.t4efGOG0*!I:0bvU@NB m4y7%njqտiSriN0> 33:oܵ “`fQ}yj'OWF96G5IC1i31V"MbZC^d'UsfSy Ѯ^̌s =`On6$}=AGyyXN<iq:^<SKHl-g9g uC l?&i"յL pdiodiR2$m*uaӴBݻ3츘NWzَNf'Ln~z⌽g;(= X#! gmR4Gƙcb8iAJk0E'@p-IL5hC@^Y(u CmGrapVr=h,2/:t-9òV8-fTjk[=?]@nJ@.X¤pnh^_ZA7kgendstream endobj 493 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 150 /Predictor 15 >> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 571 >> stream xΉ@ @זlM훠oS|Z{Kh齞-׫z^ےzZJcKuj-OKy]ZkKh)Z-WUj_V*~u[~5hUFװU^Vk*zM[5yehU,_VJ~[/{+|_KZ+z^˭z+he<Z~y[䗻}[W|EZW{ZWzE[Wy[x!ZaZ~Z}Z|![{a[z[y[x1ZqZ}Z{Zy1[q[}[{[WBh9^)WNkZ}e_iW^kZye^-+e~%޲[WAh^%5}fUZWakl ^}zVUj[͗@Rh5^Kuy~_*Li^BKuxI/%zZ\k=^Ku{I]25endstream endobj 494 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 493 0 R /Subtype /Image /Width 150 /Length 5183 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?s^D1&A/Ls$?*'dQd6b)DX|emQEjQEQEQEQEQEQEQEQEyUK;7~|`܃xa?޼f%]**1ʖ@x)ɦ|Ȁ#!q^6Ns\7|-O l~R{ty_@ ] ?~GCuU-o C9 ;yҿ+hΊ(CP(((((((,.n|B? :+d$:w 6EP[vϯ|ӭQ"YP`iMܗ8秡;WـВal~0:qW^!)dxgfɅ?e#vϢqu#֣z;[FwQEqQ@Q@Q@Q@Q@Q@U= #hᲒ)y%v7w^~Yⴸ=dl467p3L|ªv[?]hFR4 $Ucvk |ip=VG.ITp {JxO&ܥXdF0N;g]Gok}*I2!}k}jܸއmEW!QEQEQEQEQE* tX`ϞDu=5$mpn=)1Ld@S 7p/9z{N87 _cաFC)$7 1G?N#npNqF?!r#& %ۓN22ۿY9".2,&0rqc84o86pq97*X7x=n=r3=zad, 鳌g:S+$#OEN>~4eu].sO3gjs Nڛ^敕+$8߂NC}ōڎ#^+בos݌Kb9!t{{;+.2袊5 ( ( ( (< dG1ylN?:cI*<Ðv'''o"DFi[u=Eo<1y:>N0kSA̍02?_V8 8\31:p9玙⧔o'=ՠwi8 pϸ|~Od "i"Io۷1S/P1{%k"Lʈ3$G i = LI÷:(2:u) Ȯ2dz^:RLA}9xA3';둞3L130-g8ϧ{C%Fyw#׷QL>! }Mր=zGc䊌ܒA,sy kZdr5jWqgoEWQEQEQE?g_2扎cyF,3ܞi!@2OS#HϮNjrwDGSة#Zpyd{p0;z ?Gc*DWvP#lv*b iG0>TAA`'#/n~q20[vuk'"w! w9ہQ02˱!ICzNzsڢ16aSR`Ͼ9O%GE b lex`+X8?\DfTUVXyUCFx횆eJP|{ NQ[Dv19$h\5,p[i}7>t;byb"<=szOt[\,LqN&?xy}-(41eY˱v@`t8AXܑf#xRnIBc*dV1OyhD3+((iDIuoJXqCnb!DAV3`jtk8Qs /0?;42R8GzJ3;sydm&>Ǧ80~y$HK lm񃑏L5EmO9ELIر,\x;{*Ip:ێm=DSr$q9BFiP@U PI(F3ImϘ7*x9#52sR9Id}Ď;>_CÚjA#x\D <{+(gf 9$)$g2:>UCg;cݐ}?dDQ;NmN>f Fgyp~yL'Ǿ0i2dtLK6W;Hy;,鷒 `zp9"cA Jۏd猌 *);7}Ǩv⋀ehLhnUE!*pA{nKÒBpwH8UZyKٓ63{z d :? R;=C+iLjFp'; w5# @Ads瞾O YEۨa7@I\^W+[FvQEqQ@Wg-xӭ##'n7gv>]{S7 yqѳa"IBO}zqD-G Vo?!Scy[3op{@@2K.RRxQw]6qKwSNwܸ3+7XIcE@Ǔ21O }g^Gz(C4cm2[gϸz 6H`L(SOםr1QEh%U)VqaU233lڔPLG @>S׵Sq]a M'9]Psr~-_ix.eInQS.?b&dħ03s8ކp~UTnuOz(k)6/rF[#;qm"-{_4<$> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?͑M;S}3ϡu"]_|Z,iڔvV?=;a Fz%Q\EPEPEPEPEPEPEPEPL8U7' M'EG[ 1IaEc~Ox7bNOcf?=9{.KhE+:(((((((F;UMdUtTn+؋9XAL(*f:~8kDȱx7şc,31U+¸cGR}ffϕwӧ#~&gQEEPEPEPEPEPEPL:60Ta։SLlcYxikDAn ?JoF3߿5# (?51UYx7ŢGRl31Uϡ^`zz~ux3ȦWňށ*[Fz5Q^yQEQEQEQEQEyDT`sִfU_ҩJ"UuGLeh%b:8Wr}{UMMԟz|⛵;ݪu oiڛ}fc?==)9׵v h Rgoe{}:qb0i Fz-Q^yQEQEQEQEyÎM2qT9F,ŕY~/֬2Te+D+0Gegi) SJ +yΧV qޣd5i/ſbڜ}goe{}:z5x9N+_ڜve}oaҝKhF+:(((.kN>TϟV7^k2d4g5Fl+A+hc9*?vV-FERi+@-R eQ:{V)0lsǙToci֎*7Jl#kž&1i Ǖϡ׊j@q+g~SNF N̹֡;>Vz-Q\EPEP30jj֩Z$&#֭3Rjա =&)j61mMJíF5H7HU!z,T?_+ۭPl ;/^^J>a[C9<x/̦?7 ,cCӗJu-=(4 (9֩9֯LZ㞕Id >3jO Ԯ*2*֣aSjl:mMJíF 4"">jhFfӚg?ֆ<Ҩ Rin9R28Rϥ}ZЃoEOdF f'Wm'lLko>ŷN?f,S7R{}:pb0mNgQE ь}*j(""&JҊ+DI'G* )LdQMc-FZ(B#+Q:Z(@f ڊ+HGCF9yEdyszlB 7N(O|mj),ђ.FWӧ#(*RRendstream endobj 496 0 obj << /Filter /FlateDecode /Length 7773 >> stream x|XS?VEDܨUQSB{(8WE #@PjઊZk]8k(.:u׺sν77 ߎ?Cr{s;?{n´ c<1Ug'FU$UHπ#ZqUd0W(^Ҭ'iUdg!VC M8ƫuz?é$Ftr2 lD8IBk)-;4Oq` 0[f2'˘G|9b5蒅4n&{*9pbΨ:MN@& & I2ZT&rgH@i9S k)VE9bUf*'1Rh '$NX 寎%ǙB ӌN0%Uv h# "g@o3 L{ o<BB8CdV4c2%%[lQAA۫-epL̫|FUG&Uf{ѤrY/59nzҩJ#ͣ?gjU ^fgv~f#ߵr9ݪ*NiD墦q۳CGUwOi`iP N PO(@ T|zdX-ɨl#,Cw1@DZ( !GTAi VN%(h WF%(K✜JQPe(98"m'cJiYJpX-E^Ih)E{ c&"srഖS|26;qr u砜]Cޣ񉙙~aam95Nܭ_ϷȻ ټx!Zk7WH[֨Z+|ruX4\XZ[#>RUѩK[dŶ?ׯf݉^g%, mz=c٦S>\>XqcQNM\v*aS~[9y3˟͜[pD]4uh(B&KXX-0⠍K{Mh-cw߯fǤ]uykzgn AƹO&:(W I'f_87.3rdG (BSצGxp)o[i&nTiLL+>?p'nӬ[pd{@=Yݻ}wјo1 pn\eL3|g_wLޑ{t-#4W,nys[ȒZCrv$mK,|}YiHu5`㛡+k._So:֪3~ǧ4f5L +UUSY3kcO3K?=?alqzԓ[NZj5XzP??0qA|WT׻{W5g5:|AsD?E~xoM^¬#o) < :g2ɜ ,J˕9>7jqsy#Otw͆*=h2o=5o=";Avf5~1ҵp|LKv+-y%Qʳ_^& "类?uw[O%E Mć{e?Wdl}چ: sxIoZkZw닀3C^.NyO[{3hӠ65.._H~ybg'6¾=sMݗi,ڮirpԓ='9saz5c ==Jn^}/z8[IO]}pEKHr}8JuҴ'nZ_|&]O=ێ=cֱLHPyYjx -Χ?4OG̩ˍ9m^n踗ٚ=7T,sykHUdX=^7ϧ>x4cţnb),vOw7sܵeTsZ^RqVZ _wӧ(rױz#gye훟wrkClLʡ'x/k1{T/Ke.λI|5xe>pmCjjfn-r[^#aD7vNݬa߳6rlu?-qĆ'9p+;;(u+hth?7U}3g u_[ﭩ`kہQnd[{??7wrFV3臯N;[WĦ6WՐ7w3~53r95-_6ڦ' e,dC:jbZf}9 6Y;/!u-1qۿ>{^!{8{O^xS SmX8d!J(L0$ehJEP3h}ΨONyВ,F %yBO mhp}lT(/F54@HV;SwCr\!!!/ Ġz9N_ye¿(>%ءMVvLDc8u k_ ڨlF%ÿ6*QʆmT2k_ :N/Qd/I<8Xq%Nr|:wIV`>ߩ_Z>15;9:Ud]gkHF3I\S\;- f= ;[ R.x7O{|xvZf W2w)y~#zlkb\^wn;xQݛk7xkך{1nك}Z7I3>0{wiS޶x#Rbz^V۳k擵M/0$<e;AČ\1=ozѕzy͆Nm?>?>:fU_YƝKYcOͿ8cIzXpjЌ}B'bxzOdviy>#mw_^ZZ58&z7n?a>WjQ9W4A~/ /_VݷwlΩܭgl =dhmVPg78jU^-u><|y^1 {^3V㲕]mr#͒Aܶ'FDco'_%Mwʚ/&QwwkUw 79{ީ;A\ yaquZi= {Y Le:kOСӚ߰ տoAjz)Y]أ.kf׹huf?64lD-_{pֵS&,͝~/Twi6#OG}_ ;2kXۃ{t87獼nɊJ'ܻqKГ Mu{i+-3s}(Cڵ0=_|^S>JGwb?j6[W-7 /qoru|to"hDs+ y_oO8Qc.5*cBk߽}l5z?ꏅ56liwnD=vځ7T|cZ= [w6zk|-fMxlH?%Q|B7,в@$R<Đh[^8ͫ@]uVa 'E7=NNKfPjSצpU>۶"6 O\uVggIh3Z$H"X P #qZG>JP NhsCyمAg5?P]W1OM8pVb uu :/ up*R:u1\|&YVݭK7lx E&qoy-  ŁBI=L!X42 5N1(+x b,E@K\Ѭ+$픊ϔ(PhC#]"54ypP]LpF5 Jpk=Ԗlh ?sbJ4l''r% .^ fqm^PW C(hY%1=^%)Ws8*ְ8ԗ?85@]ƹTbRM6#6iBIi)EP2JQčɍR 4o88.XP(B!b0i[8 S|*!DSJ 4W̒> 1!/h3uC BsNM$XP߳J 50 /`"h dH:^Xx 0"w8jЕ4G uVDV$ɍ*Y)R  . / hL!$ &fHt@XL`A:G)'.&E\0#0) SlOn;B@C*(gd3¤nͮY3nY - l8V2I8l-~s,$PGj'JV$`{Kʼn(Lpa29t^rI98M;]% ] G B&#}-)r4<@ #(oC<`<XCu7hP"KkQrI‚H`>A>&qB_F 9D<%kH Ϊ%"vƟ&hpL3H +@djC[1_2&s4U; ibH%q~жI:LPu`:ֈئPD} ңi7+pRgx  (Q!g U":\H @0m[ A├_S.AjIjpKHْ@`/3ũcloeHcQzD:jh4dLHJ#iC8r$ X xa)ZK`] M( Ox oj4 7nQ*'`IL%t!9i8ckA*z۲0,ak!L=ѮilHt嵫묎[l#"",abĠЬ=RKJ` FxZR*@d!'B'6&Ņ'PǨ>*;9a(6Y9(}xLŝáb(Jrvi&,.*`s0+J"cElW 52t"1V0 A*n6&+Z^Px-R#X2hJs@u?#8܏/VG IYuVC fuW[{]؅_qw C8t=> stream xXn7}/e"b8h 8i&p.!. Vd\rw8.j\rΜWP~] T5\ VEh2x8qF4[P9d@SM.p{[,vZzmy|VΆ#%b9C{1 ALާit(׬"`AϳUJ=kld2 @4TV)'zVV$u(i#xȫ 1xѼ  C~[9`ޙ3?LJ-S %CL{[҇x-{xXxKBA`||P.oxlûYG3 $-9x鈛sys%7{~gnwۻh:!1"_ܫ;sﴻEp{H}1NHENO hb:߾26`5jqiջ9hpM##*󼿭7e6>˛Wڣw1ԋ/=]a6/F,ź,ƒfڙEGb[,4ԞӚ&BӺ.̋h9Ԟxv!NV|upŐa?YmvѴW6Yh0Xb]Nnj;wML :P1 vG{ETY1;#~zzyX=n/ﮗgdNNi.|3$n=.\F{.٧&U}-7<`OB=^էzz൧scMǻֆ23BHjƚw0VXQD!$ 7o6=eQfAzTGu1=*K.Xbfp@#&KJBfm҈bXXuqc-dNR=YC.[0;j}@ޚT NRD[niqK{qfM=w Mq=/-; z r P)i~F . 65כNƟg켑~t97Xg8qt%8?Ozz9ݼ?8[ιlޜlG&K ',eW}^"h=OPqPԋi v&quvpj3Hhc}z"`Kt`ք̡WM`-X|pqWr,2,Kqr,담hxq-#z0âu1b{0 <`,61IzTCF(PO5o{v&dn]~vb%s'V4*T%0$0_E|(-3fȜThVtawMD9bv}1].ث?v:aQWWVdw> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?NɧjnE݆g?}oOBz|NCo ,}oOBssT=(<((((((((k_S1P*ѓ 9$,jrۅf^N^$YS eN$EaEcCӖ߆vўEWtQ@Q@Q@Q@Q@Q@Q@IwWS1uZrU3*sԋv0hΕHP9;ЕT>rjiY;^ӧׇ ÃǥuI٧jrj0NXwtBw.cШŠ((((((M ɫь{UiXg׵r#0(yi3ǭJnAR"*bmrc'R$ya>jXӠQ)jRZ> wضivV?==9 +g j}fc[CӛC߁P.Z((((((0zd3U+5 .Fv^ڱb*CsTWaS7?(VbVGJR@#nUMaTU[=չ?VOrѝ ^y*s֬6JIOJ$3gSMͷ z+N^c 53ſbNOo z+N=NvўEWtQ@Q@Q@Q@ =Hxp}c{n9O ֡/ǥXHVfR%C>nS=;չb²{Jz$^^XVhST4H/ .Ax3bduI?ѳ V?==. M7T;^ӧ&#~NgQE!EPEPEPYd[6ԶX~i^b*aO?oJ0AS.<ܙV ˑSYa\o;T#VY;;%UϏV̘rdhk"d?R}(~~h0ƫrb1$w'kCYq_;*4|+o춋M&l,3W⚹ֺ?xf=3Tv?}oLaܣEWtQ@Q@ad+zr9lexVنG?7=Nv{SaaqTFfCCz22nb_Efޣ1STC!_j1\tY,|J<|ҥܻmryU> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?}u9?Ѿ3U{}>Wkgڜ z+N#~=:ўEWtQ@Q@Q@Q@Q@Q@Q@Q@=7U'zU^ FGJS8:YJL[e}oOE {}+gMN?fa嗢ň߁'mQEy@QEQEQEQEQEQEQE F~4aN#a`w)U3ÁQ,U"=28}L qT6!$ÁKM6U'yzv'7݆v?==!z~;ſc)jonYN=SmQEy@QEQEQEQE.*6Ojx:kR1AT,դ.!XW4үM1 5\±D"NzsZ CQ) qF5 U!ꔉ:Oxyzv,31U{}:z-xp]gVl?R|ZW-ϡ^7HN3袊Š(((-G87Z:u?Y2֞V%+F雗;װZ\,iڔٶ,37V?^J:0~-6B=;Tso ,cCӋju-=(8 (<SR=M@cRdze5 x*WҤpy*ɕFi>cP7?cɧyS8_ҽdr0a?1;}im})ll+:S7ǧjr37e==#'N7ŢfI3^=wju-=(8a|(iJd|v+ɶu袊$4srYŀ6qtQEn" [O:M6Q ||VCMGE iGQOxZQIg@<HsNEJPn%NKCendstream endobj 500 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 493 0 R /Subtype /Image /Width 150 /Length 2363 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?͑M;S}3ϡu"]_|Z,iڔvV?=;a Fz%Q\EPEPEPEPEPEPEPEPL8U7' I#gNԤFWoZz yzv 13^N،=NgEEPEPEPEPEPEPEPL*2x*JxE̬Pc2lLbp?ƴLw|Y1I3_>=+'o9#޻lv .v3_>ӧ#~&mQEy@QEQEQEQEQEQE6'֮L8?z9:9jVQi޴D=idn'=jF({Zi(<ӧ#zmQEy@QEQEQEQEQE*{V1U7QȯR,X}*6_X*=iVVad{ Tzn~,M;S6f^ӧ#~gEEPEPEPEP8l9z1f,Le,Z2J8MYe+ɫLV +)vt+Ub0p*2L~.6^^J>a[C~.}gc?=8{4R3Ѩ󎀢(((ӏ*Jؘu7Ldhk?JV Mhc9*3ew*/YMԧl~Xgoe{}:w⺐+g~OԤFa'C9> 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ı,31U{}:z%xze Á]o|V4MԥFW,{}:wסGsN3袊7 ( ( ( ( ( ( ( (u9̋i1I6r?*@_CZ"ǙcŁ=jOh2@r:co͈OEaEo}oOD d>/Ŧӵ7?f ,cCӎ߁'mQEy@QEQEQEQEQE0n m]qZ/')wxMIc SܼzR^;֌x_ZCx7ide9_;oH6*췣oj ȠN qH>JH;z{Ԃv{  x1麜v V?==U=}?;T6f^ӧzVgEnQEQEQEQEyT y%'⥅76Bo${R\.IR@q!|ZT_4ǧ(_=jIx+r{Pda1p*'>r Pэ=h\7JN/MF ӧ׃3łGjRmaEcCӓJu-=(8 ( ( (884ϧ6I]޵o™sWOVi\:R?WO̸?z~Rq}ƭNV*3I#c yG?8Tqr[#tN}WWkhJө^.6B=;Uv?=1CoKp~ҙsnIZY>qzP$sT~}(G~h")\yǞԥǖyLq{PT!'~oZd# 18= ژFT YΈ#Wrk5oMhg'STd?UC*VDs~NԤE Yz+{}:z%xK:Z<yzn'7 z+Nx=BgQE'>ks?LzxnINPw}(V {Jo,ފ*@sKb"yU-7~ECvݔ)3rBO-( 1NsRE[% T,E(l1s[MIe!h.FWӧL`JWQendstream endobj 502 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 493 0 R /Subtype /Image /Width 150 /Length 2616 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?cu)?ѺC3_uO/,jV?=;'mQEpQ@Q@Q@Q@Q@Q@Q@Q@2Yr=QidVJϯ{q9x/bNCo z+N^˜һxE4MٸXgoeN?7Զj((((((((t7 _fmӧg#^w9B,8jAAj0[#S&⣧ZQx;ſatu7ů N^**Mv> oؼ7S!XwtarR3h΀((((((vFhբH:J)^NvVT@@S"&߽QTp:ղQREC! y { I!l/Z$b#)3kaEo}oOC |x/ǦoaXwt㯇HTj((((((/MىX'=*-o~a#;uLMo]//M$FaEcCѫ-}kwŔrl1Uϡ^5k E+7 ( ( ( (<nf J,ŔWv7m9 sV)r4qAfeksMe]Zخ25V>NzsQ7{&&F֩g'ִb:/ɧ;xNCo z+N^]wZliW-ϡɈ{4;hF+:(((D頗oU ;[L=*s~2Z274zh?}8+shrdėLV;Ht~)_9tsW!Yi>w;Q8n'Ҕj W'T !N]FmWoQ+14٠~j~5 n{{,Wz:)VFIiڝkbv3qz+NxӚ<ﱄӵ9?xXgc[C:w%3|z( Š((oh?Qyӧ.# u-hN(?Q<=?R DHd;MvB>cRlEI35!hҸs|ƆhZ#-B5 1B&LlV|z0ibv7ҡ`S(j&8Z#7Q>L&ߎ9g+/C&+!Nj>i S!_ڤ,3Uϡ>Q~/jr?=8q{5R3Ѩ󎓘U?r(QEoJFQp:E[Qy8hC&j*Q*QFނہQE4p7_J(B(`Wz~TQ[bl!~UoOJ( WoQʃϵSBgW욒K=ܴx.FWӧL`JWQendstream endobj 503 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 493 0 R /Subtype /Image /Width 150 /Length 2586 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?NԤ?eXwt:p{cu^oLzn'7݆v_>ӧ^7 !;hE+7 ( ( ( ( ( ( ( (}1nE)-^-k v,3e}oOF \&xYNOSv?}oNLF߁:ўEWtQ@Q@Q@iy}I?F?R|`xDϜ~?zS׫}SV&ɗM<0?zi|VlgUf{hdSḲש[Kf{JOCȡXRK~?zNAާM#g;׭QDh!rS%1iۭvV?=;mR<<eM$FaEcC*9Q0n7R`Q>_^F}W#gZ|֨I2+g<ǞݩZղ:x^^IaEcCѫ$8c}u9?Ѿ31U{}:p0 Զj(@_U7íV:S: (Rat_NQZ"I ]y4QI0U*E81TytQV".GֳpŠ+h2$COUHX( ERlMW|lt{ojK,1 Ftg2:cW-ZPr䕏endstream endobj 504 0 obj << /Filter /FlateDecode /Length 2758 >> stream xZ[s۸~o/K\ Mg6;v6QhYITH*ރw.YY~E:^|zuf[g/z+$y3,y"Y>xϖkj='Y0t7O 9*B=I,DR)Ep[vp؄aGN 6W0KR~>[ Ru}z)ߠMy[$ݩAl1`R{%g7m8nK#GLɁxr8҄{A)dz'Ng^NF%-Jf˹T<{*6:*h% CْKB,nܲ9w+ShBV`&XV%{ >)劸f;(tl4Nf=%PgwE(`Rp!u-ИY189xpT# {EY,÷J59j8EEbv/"TM` _JuVsQP>-(Se`식=/)x;VյֻN"&/&' sB͖kTZR'8!I{ " Sb7&D *5רj؛#(ǀu赾fYEoJ©Ld=AI42;bGNEu!-T>$RnvPƔz+q[K9 ,ҳ0TȘQqt._ !ܮiX",zOE"qf' khC_Q!W:C,xbddž+:wWփBߧ'6ub 7hу# ) s.aw(\Ҷ&Φ!yb>-Y8!6(@cXo#y (@+U@o9@TYRוnAYg8bU"K=TXFUcd7Um fHQc~5߂Vi{վͪ)C.`tXr )s~ 5Z~ A͜`W@f~!1>eSN*$o>еH& t$niNM5Qa#9h7(4Z2뜎DA[S`t}nnAUHo4GYY1:*棬V*m̦*m5EB#aR]|8G/^~ y64jKzUYt.dco*EH"*?R^MabnhDQ WߌP?6 A8Iz^FYPDBO'8o']߬!vEk>)+pWlUUW BpL<[/{d7}#՟NO{yvaޡƱ'&[qwxΗˋv9Mendstream endobj 505 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 318 >> stream xcd`ab`dd M̳ JM/I, f!CGO]nnW}G1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000201012~_I؁{͏kN3~#XlMN ?/)KJ+b_}2?S:u2ض=tp-<{ p]b ^&N>óoֲz'Lav%endstream endobj 506 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 320 >> stream xcd`ab`dd M3 JM/I, f!CGO]nnW}G1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000201012~_)Y{ӏN3~_Gئvkb_ޝ+ڝ͑¾lzٳTR> 7s-<{ 6qb ^;wq {'Oۡvendstream endobj 507 0 obj << /Filter /FlateDecode /Length 302 >> stream x]An@ Esq*!oMD,2 B}ME,9O/>9})r++?Li{tW޺gdJ4=*4r[$k/Gvzǧk/lF%!B+6jVE_h F5Tl@(TQ=^5MA0l@)%T(Ґ%"MDHC4! Y"D4dH%UWܱ^A> stream xV TWȌ@Ab3Y[_T=En+(j Vр@ #ɟ%τ$ FP EGEtmٵۭ]=mOmfr{_Dxz"hܲ+i+*}s ?Q??+!h/g|-h8Go%"j:TIQ&gg✙3g<>Op<\Ѧ᳖ϒ7Sd*ING%ȣ#\9}o7AtuFD11IJE+""UD0%B7E[DXBsermŸDhV͞s<|_d$5:;&xL\->>ih?p:W` @(iTFs$0r"3pfcalx@MoIh0Y"GjװB+NKyb: 8d8rXN5?عkV0B!`q\(Edz\ݙ}6gH! ѬW[XPXgC0puHc֔), +fo+2z(`wtlv|"s .Tl`'!3ӹCd$lνZf[+B$Dk/ OZ9+_~ ?VڝBXH[¤'s'tZΘ= 5h9_+-YJЫP=vu'2qx  Ҡ`aL슕0AE:mn6v-)Z(f e4%% P۴FKŵ[N1x+o^J;$:WP*nUktA*v `[3Hߺ7ĩ&L LWf4.ˡ}f[b]>! 7d zAG.*ڮ/.32)g»orn4B$] ||N+Ⱦ6 =-$5hֵ&;aIt/5+PZqUF?{Kg^ +K? WG >ȋgIPk-^CVCeYm-C 6e*8Nj/n;<) *m)td&}cat):AJҖG7u1 Ik~(?t/$ ] ;U6LySecM5:ԍG. =J;J!Uv44ն1B@H %%f6sml5ځY,ߧ+_o:T?no>#Yqa1IVERFtSBYM9y zV*]D\E<,r+ /b>%<^,34ރ&,A=EEJ46-͢Xg0Ki^vI iu`lxFsi;:٨#ᎿzN֊Z OК Pṡ֭_oØ6֤'HzmYSB(]_r!qOx5>܅[E ?!mtLGt7JU.Ἧ0ޞQQ}ǀdWn[wVUWTV>Exendstream endobj 509 0 obj << /Filter /FlateDecode /Length 270 >> stream x]An0E>o! &dѪj{nj#1!޾.0c:O> stream xT{PSW!nA^WMf/XVt(ڢDb@L#!@bpBx;<%TJ٭`,NG[֥ݝ\ؙ!uΜ;~'D@ ݩP0ZfCDrV^ p/pT`!y^ Z%ywbBu[|UvN6**:"n,#ejPV2dHYcd+`VNF)c=Yd)w˶''$^?]1 h_PVvJ%a,ۇɱX {{ Xa$OafA_S-«pQkwńx r6|Iޟ\k?5 Lt4ސzpMN;қ# Pvvȓ6w6X|S##mI4*Ph{.߽U3<1^g.SA C#@LP:M\.Oy&n\S(kX8:۾o g #$J(is?SqgN?iʷ}!&\=O8ǍAu3>ygA~-&'U4&?M74wxۻ<0#! I٣w F[V@{:\~>fձOY8A F4EgԿ ~ח_ZUz ]8 @A`bv;puީ8Ngu JKOWy 4ڜ = ( 5Nsn^gg8$4)T(5tL "-~8w&olZ/6jd>C&<ӜOLy} 91+qB }KOW"~+?AM AɸTiN'7d_r^AwzybKc~mi#,P;s3W%.O-}Vr et$#Mܽ.h*K̪r2bPX4Z ۟JN-fK΂,Ra ʴ7Lz5z^JV{ 6{Sh?'j.`LI!whVAP vOpg ODk p=t3|BMx߯4(&_{%WgW-z^]JT5""VlUwHˌG@ajg&"DHBwcph8yA*AiKYV jAK].s+\%}ޖ6K}^OyoN#o_34tPz -̸+]{PKa43$L $3z>o$0ͼzWt+Wne"/yyp/J(\:;t c׹\v˟rjt0hW{=Z<|ow6 II!u8\Zt} ǝn /R₲h4AR]\Gé6` Ka'|}(z _iZp9oh3tdZ:jNku56K 0?.endstream endobj 511 0 obj << /Filter /FlateDecode /Length 1860 >> stream xWK/䢚d @[I85nJ9"G%߻nÐT׍$i+iKEǕQkI׹c"G ,@8gd(l*$q"$$P7 ť$h,VliNEBX 0 %ғ t8EIE,M$1E.p&$T &IWCݚd { \ /AaZ=.3s, 3Eg[%Sm MsP\abME(4kb)ym Ҋ =/g)ؗϞדc\PQKk_d22Hs);i1Mc[oV@SL'a -Ry0_TPOa~VYCfK kBKi*Q8}Y]*ɣ2De Ԛct*@ę>C }yѾ:hTiPCsH>#uӔ" S]d y+m#d)dwxsFR.H3[$>T<9˭xl$ Lnd20\XSLN3׬ߑ~c!)V;Rt5MnAnNu8q_=O@J8=]t\JrwmtI77(v+MnT? pO1B`+_ ,a,1>s4X8#3x|u} E '>ZuF><"0S%W<"\Y[iUsM9{Kizgr\&6Y\7Kea -Atr.Ft5Zؠ0)hQٜ gc |4L)оQ(j\(ͱ>;{=:9š٨+j']8װcmîs[K11`ZFPe c \rD" N٠QW.=NnγYq2b՘їZI@S"7f XP cܛi )N"ͻJ2ecJ+Ѿ)=9;KZ}W?^MWџݶ~}Տ_ڗhewS3qeۉq;C @K0"qڵ)0|&w+4KbIû>Y/P=~ n";1Du*8uqX7{d cހxNa6sy ű}:^Ox-H9y{saﻻBV6 (kzÎ5l\k˖Ч*ۋ|hC ?٧ʫn_q./>n^oD<ۡb>~];s[r-kK^7|j]i BL/2)[_oWtendstream endobj 512 0 obj << /Filter /FlateDecode /Length 5911 >> stream xŝ[Ǒ+ ,Yݰf"`D0y8V~:'^6=Kgr_m?o6~M\}~qo>]OTmoo.Tjc;mnOM}xs|maWˮr*wWj{4;,χ\qVMN*).ާ7*y1]˼R/~zyvӓlx>'}i}͞})nwߒK޷ðmOq5z}Uon/M!]f*}vn}k?쇡imݍ4MuZwc:QUZLUU_ީi_e/}7Wdih87EUH35tfjVuejl 鹳w-/*V?ZI̖*}kZMS];hl7T]r=ߔԩ7:4>k: Jzik++tiaU NΝUm#U7A+M6[]5̣gw"XSWJ/*uƶ60TQ)o]f/MjY~(qmLUJ5U)7٨j\5Z5UeT^[\U M&(UեFR'U~4T)^L+9~O-q5r4DJ浟1W[fӖ韾*#OUVs/ںJAهz":]CÐ@ٮT8ԍ Nc`D@ʪkr]8e \GUMus%eaK5QH(fFu(@ \o 320p |LH5*!<̱RD=/  Rs)`K@*1\c:ʧ;tŃ i$Ń{*/QP|`(˂B]|V2H 1DcўD/$ɗSkWNK@#rUXjdj30oc0*$HDVH)J g* V-"r\8l@*F 鿢=c>1V )3P= B{V1gE8WTp'䉢}H>j vUjmr(()qGiasm^Rk>.-#a`bޙs`>)2H4o I$ZYHsZP1J sѲ+d &e%Z T)Z u IsfyO:O~…~x,sqM^o $bC>%iė?+OKvϔ \k30p㪃 `JbLpnf651{ L`Sc> m:B '7R*b{Ɇ5}D;­\`SHA7 2Yd@RG*־b<  p4`L\'D@TٚA+xĕ5CJ" SPdv$ 4e[1`KU0 )+7|8\C*< Pt8o@78U ܆F%pd| wAL7bppcL9FH<6,{ٚTp8〫ώl PgLpC.() vZJUbU4. JayWs%޳%pϖpM"-SZ=Y;`>~ް`hTў.\ }ik';EW. |(.Dp*`_GMVp͜πQ[ bEa-' Pb˧5 W J`4y%8Wk9H\F`x \OI.PA N14 M{=!pU#g︢P( d)^)3*)|H :r]Qx/$”B(>TXp*<P|Go |KEpl^0<_py 9+~h]]+Z,Qp]3ί|xl ߙQ>>8fDZZRBD }ZZSt(Z᫮,w+F RCB g RM!pQJ J rI)jOJ g Е¹RTBQ%] K\u8@7Jpw\ +$HC)$^R|N;XJ /+%,(NIpF JD FC~~$2E9՜j1sŸS4钀ij0nUWxq<5 CW=>ڟ~]R:Ҹכr?)ga_oΏGcno9͏ۯ@__=>?)+tf~f*owNc]I=7VT&m^ÛKM_5MVRv`<qMlCZ?Է9(Tu$\Җ#у9K|gͻ&xjsqR]eH7=t*VΪqpNC ?ND,Ԥ#~]87\YԝE}K])u $ ."EwYz2=߿r8j_d` ]]߮Lj@8={s5ʵʛٱ)J-<6cqƎb7/,eoߞΏ>HܜLJ.ss/4욞Zߦ*Х|[rmM/zâJM9*1jm3cm&kuo_skkγq(Oe^z.vWhby! ]=\qwwʭWge]L|ۻx)@UOwۯ~~:tPs&U!u]EYrK]5:tOmej?Hj.HL4~{g3/NƵl6]9;j٫5Y: ulaAvHt̶Y;)< U0[cEYEeYl,nR@ /b' 7O}‚WM _",eeY&"bVṮ eETZPĮe09GVĮBW)zCl _%1_}Y aٛ vdF'`W8u{pX,2؅X*vyen J:Uzj҅B5 +peNKuKrk(X/F+ V(^1P( j d dBblљbTV b", * !``S l*^/ V- -87OzE$0x[WfsDUxثdpCK \\pPd`wAQ2)8S2ٗ<, KD0<  #|4 ^p~7IqĬ0cWqz?=TD5+xDukIr+܀ 0E^v*RRd_* \1_{l l᩺T5b<8V.3eU,zAl{{ nw, t oA@3:pypޯt/(HQ<D[{2b4R%]>T\yL-уDчXCTx h,ɴr(7?n [t+pu4Ne, %D NX0UADr# 8nBV"U)_3Ua;J 8YFQ]%7hQU^n S”r^Lt>-Retew.-v34iVSlafk']\^E\h'K.ʓ(O" rIEIT0/޹NKr&n$='+ ȉK%fxlV) HEJ׿,1 HEdUptv1C*F{Ft" * u" MSc.CU&cj7n0SJER$(\.%؛8p5:>uneHE;?JRaνRD >GTEk<*Jz^d٢)+BtZ !UD"ˌxПcx!u_D_v}>h W dQ41*XR4p ?$J;Kܼxd oWŔ  ´veb&8[e 2O VNGw>LW*p uڅ,p+` < GNRGi>U*pmuCkP@PMsFhPWN: z-&Rz?i"hT%D l)~sə , -{)Px6)M$J"!Jͫ TRBS/&[<얫<_Ij8uePEumuͨsPjVֽ`ޠ.c3k9^)= ٫ZnR%A1d]RSiYWEyi'yyc:oS)r/}n&tO(fY^S&2&D2?+qRa^S<1O4xBM ӚRL|)=3d|aq{9jj\irf=Ok\My)~"HO-ѕTߜ/y'M]}Re?OQ^;KSKex^h͗5M`}m/K)=>ϑ6CSvl?a?cz/.ANPOcZHR>۱x[}𩔕"J~;W/T<*]˚ qTqPN,]}.Vy(>}ivendstream endobj 513 0 obj << /Filter /FlateDecode /Length 2816 >> stream x]sz.[ ~bљvr8?m/N)E* g=DtӌǒA>8qXEUʢ YU~"+./{GMb?Eқm]6wz±3ü*+kY5b_#/b3ZUeV$hs'dSVR|НjCx]fA~o9,o]Mcqۏ4F|Ya9͉9ڕ҆Ȳ狟foÔjiJ% dC=(d|gQԪ.>?QFI餺pJe i\Y+MkfSAj.‘Ԥ8R+sҥ3g [Wv|TLUFOG?ۙe]Jr6Sҟ+ʣ=3f-IrSjO늼<ت dTƔ\$e4465 wFT y6*dELc`( AI*Tb`ϓT0K5L*[a5GP3j#BSb JA5 u JJA%`(V B^R Fb,lO˙Pj:V)ث$* [! kLVAV0+ {ak31̤U*Хb(PI:!eB :\Bؤɤe 6!CآJtM zLHӱ! *) 62Am%0FRbp{,` 6ZaeX֓V4&HVVa(J(Tb9CE0PT $/S JaYب6g@SFMGnyX)Rbp)*9!V )S(}I)RfauoM@)LT[I*T= bK!v -cEĊB/8z#l+UYqĻhwbaۜ~d]PutrT񜧷J6b}9&9^TZ;Ul8zyb׮oyqƮv8х(}Fe&(#+:|^\>^3si+[\hY%%iO3JAu lz3{{sHf5%Ɨ#_ExCqWM>_.+\Wt @!׮ߞ.ϗn]斛.5F^6z*6hR۔RmSS N!C0%޾I8e&NN`}>USS>@8 F2LmS  ۧ!9c77zY:圪iDAnP qGV=DEX*lKcmX8w׆6UB rJlBeρZؾNNxI;3a=T43Bd3{)T4T%|WLK#ewq]]˿3Lu;O6wv~E [J"Q ۩ YGq"i+tiKk/ lacT 4x1uT4WWbX!(N]p\'&wIgWx/`ԢL=۵߿osh-v]1rr׻짨iBʄ"dNymݗMƙSW(WA O8((WzE 0}?endstream endobj 514 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 368 >> stream xcd`ab`dd N+64uIf!CO/nnC/}M1<%9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5P\0000103012_i eO_^Pw*ˋ T\)S^m. =wnw6/ i^O mӺvKc?{oi~}/.cA<_qsg.a][9\Ğ{z{&>&20gendstream endobj 515 0 obj << /Filter /FlateDecode /Length 2621 >> stream xYˋ$I?,$7B.l:gf籮<GꜩɬxPVAO7Ex&E< ˆ('#3#{wЋ CeF~E|Gi47:e(v4?4RF2kN'n Nb:\ftNW1QJk4[Ma%ZƔ,): j#a6' ABS3e9F_>Sf Ʒflt6@媢ۍ]8:KV` QYΰ@k7'"}B07Dh yc*p&'f*TS-;&yb3s~8'8*a-UzVK@(ބ xWVZ"ϘV2^eܬtZ2x{rʅdrdr5J&'Wҍs&7ż8ؖU9)WMfKY)=>v)}o[˯?=/{w~'%է||;/㿽W|O_ʧ^yƵf71՚s灾:!BLvd5(Ս,#IP-Cf aZ4#* 2ZLP Y#IHW7H<: 9hr"GtqAn1$8E?2H7J#! N@t֨'n-.vsRgJ*QPD >vzMu !ᲔQJ2..jVgѪܦOaZ/b-MAXL@N w2 }udJu#]P9X(ՎR {ڑ@JiՎtR>T4H E-Z#UOW;HzPi;$PHp { V`b 4 87sCeHA*>TdH9t >ӑ2 2T$3O )+xbHCX F3?[Itԩ3Xc(hrvU,B63OYs 9;Tl[O*~]ryD"ӈb[4@q`d'`)h BK F(vYY2"[CU3Sؚ3@J0ŦGfZ^P]F؏b0}^ϟUX==3C??4_`PvDx,ʍڻjYV61=`p֐LC*o<HژH0\t5%MmP1z}yee&MAMa@2&RX#([0Zͭqp#kc%B'c@]ѡЩ Liem(T{ݗ:z;8n98kF~wlF< `_ARӡ"j*':QpT:N+[hp>?,~bnzF|Vt1"cٙlMy{p>d9i z!xka4tZ 5]8?3b|x"0k.)9Js3'Eb1)}k>\9~ᗇjf0{w?ńE%\f ύ@4"w2'Atp(lSfRbϥq!<3}pm龯GAz: F PWoڝ wFJAA 9$챠Tϵ (`{J)_Sȓ"34T $z\̃9ehTlYEMi Uݤaퟕc`{~5ĭN+_Y6o,G1 &7N ԩ(G~dvlvCuǻ;N0 QqsNh&wE W}ݜebDtELj˒| 4{6P"do(\ 9cݧ.,lӔMN^nD0?!ǬV8*gRݭ qي)} ''#* aZem>wOhCv_y!qej mQ_w;){ڿH(V-"#&F0ܚB;;u}{.բnzoQTP]jr :Vgz w!|nADW]?01MvWc%'8HqOt3`qm48XF #$bp*9[Oo%I"/|߳yh%=lRqbct m̛nj(l3Hy O;o^9#`lq8;0 U[9Ap {b`x} !\|x? /ӝ?6mbjEz8*¡]/7]̖j9=~]s{n)=ͣQ`G(wc 36KeN <H endstream endobj 516 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1417 >> stream xTkPWd7 (D[A[RXAA|T A(uk(eT_!ujh8&Zw̹=|eLK3f$赩W͈%MNJ+®R*kx)(Fw$c+˧Z?}zSnVFQYM&uh!+#[G4>GmmfP%gԎ'B\1?ٔE+Wšx %-G(Šf P8:``v2v\I&]$#d,Ϻ@,luPנ.v*8"W8:tbs@Rrp>$ikL0 Oei@90 ^P~!aD X,VV9ҧtI~]Md1fTf vCԯQO;w*W?y;f"X^1c;=O[n鳞;*7[:LH+í8 vtu͠0O}-"2-",vE#PAnj]rŊg?vt_ISKK㓵!bK%#HH^CAv)b)]u|R=Y~$ is#n>Ea ٸ̴;}5w7=S]Sprm /'řfϖZ OMG27e*;R#A(]yk-a|xВ8'[UakOZo ^0#Ax`w߮? $2,m W*"p;6&&.weGw]7 wҧ3jJM|s*Z ۪*œNc7U۴krRcy0ݠɊT^Ru聳dj9la!q׸wZ曨h=X: l,z_D]#H,l_qJ8Bwtaijp^i/k/u4fl;@Dc tпendstream endobj 517 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 335 >> stream xcd`ab`dd74 JM/I, f!CL<<,o$={ #cxz~s~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+k꡻ /,/I-KI+)6d```Tg`b`bdd ˾*p?nv.WVUUY!> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?ʖC"5%IP{IU;9Qϯcg=p%#9~۠y"\1dC`F8gPI_Y/w)y6Sǖt:_z%J&?2p2z~>Opr%D[d=1tKdE58Mہzc(9S?yNz,u>B6`pt~*sג6:|gY5+Îw-yǠ%-v ̠`ļtjo/h(|'sӿN\v(nz:~r\-C;[ci vd38:c??µ!5y? =3׿ӥE~{aa C(ϘpJsϰr!$6 ^p zZ^ˀ]i?|^}MMBX3K{gqH?MHDA -!'n g#f("æ_~Aà(.ĸ NHA|z~4U L17@ `c?N;Ttpe2y{5̪Σ`<>ޣ9뚵2qBǧ_xid`IӁ8TP(>WnݻqM\36 ϱƏ>g #0H7W3Cq"`_I[64lg=E`;T2M('q2~~ji%xdiU1(-mN3M=K>zդm^?,11ץgٷc/jeI +:CZr]ğbh_0RA&7or8'`sSbHOo}1p98~1p86d 3[@k۰qd?-n`-Oz+XbFw2o=E!~}vN?Oz8g7?Ï+APIA̻;]}gGGIdbq>ig;z򦕛??'hM lnܟ+ 3ӃFNns_ƜXtU?!ѷԝ8{%x0avsEoLQ1+rGN{yG>f]۶~=-O6.2ෙ'Uwܓ0azP4RP帋hN9ۏu=Ci[ϛv{~.-?#?u=vu{Ԥ2v*B83K62̞c#<÷|E_r/)-y=:}?ƪ,is#oO٨RI`PP>89^1k _y{v<e`>޿=)LjG9%A=Hk?78L?3}c2Iѣ3$&F;`'HB""D@ '_AIs)i<׉$F.LY %\ٝvȳc G^N}Ձ ?`xu*e%@pO#%r<Ҧ ~l%1PzCnKu|Om8xZ\03ɝ!9-r&<= 8䴘\\{'#b`cS[&[|$4bv$w69Iā,d=AK$),~kq*Dc[<9~zuj(`2vm ;02{h_lawFqojM%X|qLW9ϹwI.171ހyf[?3oc[icB0\pK|۱8;g4/>Fe q=?#HEk+zh.T6W *-~?QDwY̠I91R?p?fgY-Dm ܶH##1Uo!21g1 o?Ş [G {+mC]ޙ<~dSPNߺ6 vLv-@ҶrNO_ #;vA_(>=r|ϻzd}ޙ;mǹg F6٤n?цt˯^~�BC& B4%|sМcϿj&a\vRYciA6' Fq=:Tv)_0eޙ.y聤7DI#1ڿ7˷LP"l߅2/=y] ~o19⊴",ǃ>a9dB 8\03e<7Xmp:{ǭ4y\d9 s IFz.v|`iciݏq;E Wmp3ׯ?.Pom{ws{ dH:zv n=2z|9'\8>ߡyQ_D:~NN8N[y|>K?큋`vœy ynҹ2 iyKwpԮWd^pq 6Q ߏZɷ߷:I8hsy#䰴 9YJKd`vqtM ݸ` ÓNrH皋c P/@d!_wܒ1*>xM! a$wy)]Y*۷ qӞO]g,mqw͎PoH dyS,]GsALMv/6Nu秷JM;5OgO͎T:dD(v ONhcsmxªy!#Ici*Z/ws8ׯ JBe1ۏ߿\iܮ:?>{v&$2X#$g{Y.pSvpFFrq2j y$ ۾96oEW8Ƥ,yH78 sPq@RɴM&d-Q}ރ"UHs׿KW?<Ĵ{3lzOƃ3$rB t=7N)Ux6I7zc6Ze!~zVfO9<3$Ue`XZ$20+lzϮ:R! (Cogn?jK %җl|ׇ \ij0,appv xD)E 9#O<{ԾRy' &AQ;HN#P/9ǵI fEOUwYg?GR&D?0' d\SXPN>S9zrNפ\cZInynA8FARٝL*. =FxhR t,cF?:N>n~tURΊZ( ԃ9??l?=J|scߞ'& wf ]ф]&ZUX<&`1Ԟ;22/^rۻx abLxےbe#ji))<8pAשaT݂v=1ݺz|&gvZ: }fAcG6~Q۬rln[fˆCaG͞'Ê\;U[˸_h0Xo1=j1FTEfcq mw9)r?, UX&3?I*ƆaE39ۼKfM̃zqyn}+b۾gZwTa.Jvo\vvʹr\9P`03`gC0XlpI\h{+{T1\ɼf@gBFAI>zԑ˰D 1ꀂFza[8f9QGr>* 6烜c2Hgbk9%q,`g {=:)eU|x|À:tzb9n-żm'nCJyl <ӏj($јc郎; ~n,zjq\,ȥp3:bgm$pp2q#ޣލ A 6ōs>;1LA p2|Ãu֝凳+7$r`zLM69|R[1E:q=r~n#׀>A9$ '&,ۏF8N)C0d&A| ;w,IMo/7~}sUrIa y8)Je@8HQl͎{XDclt#\ w=I`d!<,|ͺ,㟻߸H(Z|+"3FA9 u~_V*1LYT~ ;I0>^:Fls2<^2"#L+w)OQ?RqlY4bn4o0 r6vt#"D*F.#cgo'9"I!Y`:/Z=m<<{UrD<79;rx$GaǠbGhQ ث\1ǵ,X̌ ?[pyِ|8YGapsETO\]yp98*;[Y-̌ a98(QWz3<-rG8cެ9O?8["z!i,όe81i&2YBŝzc(%Ka|wTymOLx_Mg(/b`n~oq^Ɍ-}j(HLY~0Ejy $q~b[nL Ɗ)5@i> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?m֩_~=(ZǸpߥ{@9OHj\JR4VQṢ¨+p9<ԛsRUa@0'PZQܾ 0k9[Rܾ &Z8Ce0W_sXL~o®+}kQԴ^z_; ZPZQܺ&NYrj~{ԊF;֡q?H<ZLH?J\"ơ{W}­W4>QQaNϽBJV:S#`)$AZaюOjɱi6zSSvsWySoaOSӿֆT^NtSܝT<ԈG5]pzDa&Lٱ?u[޳|]Vrjl{҆_Ҕ0*,2P-=JV7V/=Fd⩲sW&UelZQ$Î;ՖN*=U+8+ʦ)M(3󪸬W+d:X)zlզKEp6ϧJz8}ϥ^ll!WEgi'WC$bjQQQbAP֋aOZ*%~M65{og+bej5dhk?JV-FWIsYTbZ&+ }=Vj&Z&+˶ңk.3tj6)Rac83Tn*6FW:q`zFWҨ[vEj#F.vih:UOg8?(8K%''}H7J*yzTÃn9t?Zk͉ȘTDrjfZ"'J3V4TuښQ5+ "ޥ"qTe|P<5SnAֺ&܏{;nNzϹnĬz`Z Hvcޔg?7q֤` `Hۭ08=z7=闃TsҼ,֣#֦aQB!qQFER:l*cޣaTZXuۡDGң|cMQ?֭ԱsT~bU1]0[- ~ @FGۃJWZq3r2wr?:@n=};} ؛+S994SK Oj*lUU1ӯStE"d}(D2T{(ҞAEІ2lu"2m9L>=}aq14cן~QVH'9p$ tҊ)1EUfLendstream endobj 520 0 obj << /Filter /FlateDecode /Length 1604 >> stream xXK\E^Q.ѝ v-tu!DL2&G 8={:!\(Qĕ 7f(]ĥ(DDOTݺ]IY0ܪԩs*awc\0U\-xDIlJ5yN '-R(%w ꄁAq\teqg\9 w;rtai9" $I3`xtX L;OGř0A-5(5՞'gI.=}'lLagũ N-#aU t8A&3%l}w>9^yDc5Q)s8(=&,!?jخ=qrXH30Q>X& a#VVFE D }85G~xČdSGb.Z`A,jDM`|8FX7PXס(:uA6e{0L|. cHWXLǡy&*$B2Y[A%ƨfo`>ϑYbT҄$|c,!D-n\EZ i2S`WB3< v%UKJ4DŽD-#Ҫ!HK6-k5H<3jjV-`%JHԒF2JHVcD-9ulV-8 ը!+UU˻j4NrR'G=Ԁ7qkl{YmOFMl Zگi #僘R\ 2jeeBمLYAk V5G2뙕JybXs$Y{md{ &$>8l/P@nLQo>Zz`d*e`̂U >K%UJ 4T*]U3}J@pC'TJiشp%DR y>K%UJ ӄ$Tڤ2 R s}JzT/,a|.H .# ;ACcȱ5DnƐu8b! p.BFrt4 ŧ˨aR?^\\LU|~xY.\d~zxDw U3,+ɎZfnj>mb7[n`jSQU;ixA=> DqK疶/nȟ5$O8S߈)L><=Qζo߮pSO=[<endstream endobj 521 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2719 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?OFXg?0z vph6J)S/O>m{'pk{h(.QS`,'}KSaT-j2JnKS$2͒$i[#~Q$;:׼rXq^G^h_C0)$tzbba?WaPjGӿ5z%Oֹ'7[bRf 3IEHɓZjSR2X7TCT,j |un&Eg?*I1K)/9: K/%r;Rҝ/8]A8=iFyUl_P??ZĔQEfQ=QR2T>襩,RPKR*ꖩ?-LET ~l j69;?<MovX,'q=?TG}.kOU9sz ϐuEP6: <r.ùo{pw~EO+*fo=COU/'_=[vQ(h4/=?AEQQQ;vQT['[hzRKtG4ozQqpzT[ 4\ *Πc*dcn|urJKb&MQYu_gn[z*U7E疮DHL2ʑJȻMd][;Aߕ n?{\ZE娸+`oª]Z?;ִ/~ܷUB]*D[͢қ`S_VFrkKlS:?7'҆B\[:έU݈kF0'9&թ> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 487 >> stream xѲ E?k]ڮñ&NhhhhhhhhhhhhhhhhhhhhhhhhhZCbW z?RyxKgՍ Zߓ8Zf-+aSѥKZ'(JmнnH_ &ƕD jL)YC?~gAhǒA+*D]>.#J&v@K-hoAK-R@K-R@K-R@K-j9%4h57㬖B fWb{^ :TVc^6ZFsZߝo-1YT]ZURhy'\2*-Zًegjꌖ[:ަ]p&1f`DKXp7Kendstream endobj 523 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 522 0 R /Subtype /Image /Width 150 /Length 3205 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?lo^*JReidb3ܚ%u={{o{ KfBhv_ATtUXW;"4oh_ t_UZxhQEAEPEPEPEPEPAc GqI1ϧYuf52Q5vU9粱XJgˏ 9o_) 98GA4ˁrނ=;1]ׇV-'#]6-+o/S1{f' *ߙؽEV%Q@Q@Q@Q@Q@7m6/'g=x[{|b(ֽ~7B0qe{S)=}i^FppKul;5]EЦ'FyB܆;քLJ? oЍuz/z <9 kkտ?W[~TvFQXQEQEQEQEQErFҒY@07cU%tÓI֮bx7U,c\}ʣɱM8KiJa]A\ǽoǧYG""$|S/l,_y Gw݇*9iEFm#xIO?٫M2Ȣ$F%G}r ^O^5 dy#=I,EETݟkx+ueovH /ֳnBڸHPr'?vEFQWFMͯIIOBO }`gg8G?`}OhlO>v+Z*3?8K= ]u?#Kuvg.q|ڭ GnޯhKRRfg Gi-՜r%~GkkOv~rHiUI迕.#wS@xz9_GtP. LaN}E ՎU IEm@/cP!F$cJ?'TRy]_z/ɜvoC)%$g^#g((=#`bH>Un f1cRpZ؃F()i- /izz孂f+oM(k4QEbQER;PsΖ)N:@CG>2?k#Y. 17CͯGvOk[ڣcBooC)#qbIV>ޟ40[9hM5'q})a980r %GRVOro*jH+^=Sf+^=Sf"z((((((5ٔc+/V\|֦uH謝X8Y/c]l 3{R}`xiY/jgJ@=km * =i-rȹy>2QВ)E)Hzg]N ay5I+Իk#vcz[O*D-ֶ&2}:?ʦ"MV%Q\Q@Q@棧-ήY,YΌP+[1uV% >AҨk'yW'}hm-I=j ''jE?4{{R7_ڵ}ɱq{"~^_z/A4qO'~ڶM&s[d dK{ϖQv=9\/RlMK2[JgjMC6=O'a9jҺ%~[myy^+N=u?eTV\EWQEQExuv$NGaT5S)JO2) 嵄\C,|i$ʱy7xu c'jo4&S5C:${Pp<9ܿѪ6#E؞Sbd`zT#]Dv{ۆh"'|QMimahhޕJ.S*׾{Z:WI{``?>JQl%<=y#>N&:;XZ=t 5 yR ~P9~ +~|EWlQEQEF|ّԜS|* OU-4_d럾 m@|Sy9`fIjgz sg}V$t6f͏j{Kݧkp+̩݁=ַpg>QZŒ?Nw>3y*Ԗ@=ʓǭQZendstream endobj 524 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /Subtype /Image /Width 100 /Length 18 >> stream xc@,`$Z%:dendstream endobj 525 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /DecodeParms << /Colors 3 /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /SMask 524 0 R /Subtype /Image /Width 100 /Length 75 >> stream xcd_ H2` 6HD2H4A I v{2 Րendstream endobj 526 0 obj << /Filter /FlateDecode /Length 3036 >> stream xZKܶoaQ1fB< *98:8ڜvU)jg45;Iקɕv\=,aS¿ڜ~two?;{W9~} zoԺ;7W7Vo؛myXsXv&_6*EV8)XվU;efv%#ھ}ƶxnv쩗D9 7ll/:1U)͞kIpE;f'Ak&;U <å0Bz㺦[owe^g‰xr]]DSOT-K$5j $k'$Q ttMȜ7S뒐j"!ĐRqkIF%4 eY֥Z$Yi։fh6*W4Rn&B6IɫLjYK]f$9!i&Wֈ/H U2 jE%D;Q\pO+ @hJP:%yMeY܍ZeX;E o( ًu?\ Z׊>Q?]_}wkR""EWBcmŸO&h 9v˚r ^e Gϔx%{\[e! t5;%:9n5icQ!hլ3Uo,'dZ ǐsq []{; z1*g#P: YYƚ;ל5+|G9mas[`+$x}id`1U&b1IMIL K$g%7<2}t.edfܞC`I>$,o_7 8–lN]nYͺ ;(xx45{4vLȜ@]>C`X# }_*=h+Ԁ 4:,ѳd~,>' 1QՑs7" ;V<#n¦ lQX;J ,@+74ǰ ΟI87)2S 9Z$/]o[-616<'MȽt§,m̐=8v0u{@C:Oβ9-@z[`TK0#Fx ]ӵuvfЦHmyGbgQ'%C)9聶u()X3:}x@dЫDIMAUl Pu]өc\6a[tk-wtZarhpIκ4Su=9.фm}Y.USXBzEvp itLܞБJo ms$=4FpK+#% [$@N'ݘeBYMi}-Yf:!:8so_ J&!hU~ CWU m>-ld`6@0ҲX<~CxCPLGK븵y;RVQba4/4ۑy~2{二ayeZ*!6F!hU7%p61 yJy4{ W \?Ӝ{e$}ZH ݏSɾx1ZA |ka.7-K,e-8x&/!7z> {hוeÞ[+<+Yo8 ^hJj# )0C "DRHL֮%G+i*LsMlOD4Ѧ(Ae=A tbD=]X6WOjWw`? -g:Du8J'X]o|ɘQ&Up=ImX/ňEB> ATnBHH~4Cc8PbT1 t輠"8;:##qRԳ%ÏKG)cQVڋA1pKM-=hW r/L V%XGa4Ot䣜)1F^ݔw[|$a =]O@-H05jza?+P, ]`KP]YN.(3o;y` ջ՞S6V ; Pc߹>2_:xCMxkE{e*^[+j.L̏B+QWʇ|8_Ϭ}x!<4#ZS]+# ܚefj_A?s$i,yOĹ~ Rʬ"ːۀDz|=Ii 5e:y^.44x ]p"}i$F*vl^M7Y/Nܼ:o7G_, %MbCÊ_ҤK.yR>>T\ῼK,r $\WJPv[tJvs|I]_TD>!OBw }l;E'sA;Jk?pTW?N /endstream endobj 527 0 obj << /Filter /FlateDecode /Length 3070 >> stream xY͋%W_Q΅b~ H&L&<2ȌBMwOOS:Jq) nŅ;Aq) 1OQuoם CW:s=w~羇yYм2+aFh.ˋl‘*+/fn ͵EeXf>kV`b/EeQJC2dng*+a 99gEU=;5-+(ċ(&(JER*[ײutPVP&093\v0{3y5<ӊBB tbTB|^!W37Sޚ,VBa1e`@be;/sl&v^is͗rJ\yŝ7fwr*aΪ=^n>.e׮~|{nso}?7~Ϳ37ϾSo/?+O>{_߿_??\_zWc#j\H&AhqTa*5p]2+%*X," E,4R(Ml0Iqp0F")EYQf#8Yg<ׅBgQQP"i!=+gs&*^NDgό*03 ̀/0%X3Yrҝy:Kc& < (8GdYg0(;w{Cj)$e-AKZh1ؽu)0N%J J@b]~+uX#`(v;Jsp`p&(X,,*Jȕe]aʁ^rPTHIZ@KǻчG$)p^i|15`|n}-҇%/fu-攼۬yQp{ DANѾL5u+52W6d$YhEv.&3NA&kTiL9 9nENnAem ˂ 'c-"K̅৛~18R38N- U qw Uk5* $zϫQ*Vx+ݬx$4b! mFpsf&/OTjJ)ul<$;թw~cDMk@<Xn IHMǃ6366PB`\*DdP*qͨ67AA]*iϡ]7/.B3!$9ln'M;I΂(:)Y RhO!2#{6 |Ec^ WPN&_Aݕ/Lo>x~0uSb_v3[9eH(J^/M(?F/N ǫ KM0;.! :I$։U!(AᣪlU6X%eOj|d).Md gBђO2\uJ*\j˔KMp4]d{OqJlC*Hdw6BNrU>bpH z ckܒԣaW Ma LP7ʻTt^}k Rt`WhfS+, uۯT>#oUnSqo!DJxM5KdҢBw5ͅzA}$9&JxCv :[jJ~|8MEE]Ń~}JFW}-GlDv=Ga~ۇwzSGdŔBkci'o*JVzQKBcw)NZ'(rj -s1Ic-Vxkra)A{K9kX]>Ze:dK\68 Ggߛ-Q)Cپ і;_wu Ŋ/VO[%Oͷʐ;2HXUL1 j]{ > stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?>a},ǔvm4LѸU`K8=mXIޢD??QЮK3{ZO{7 YDfĈ~sчl_ι-cu :o͏.MϽ,>Kc9ʿ)~ZYW~uRd1.H? n@=H?B3@7 Ӯ7ETQEh&nW?=i6aCV#:T'b+UȾkWF;V˨>8}JSs7d&$_0a3Lqח1xEkur'tr)GϚݏ?Gݏ?TE]?E.7LuU32yOOJǎ[q%y]A?jq5Uy!P>:=̳y{OD/Os["L]i])`#v:nTk(ҺaQ$g(\ε' &s1VdabiꄮERF5ec?cF8a޼ lبЏ}>Ƅ|7>u/iE VW&gz~UwSqߔ /̼v"KBag׊Yzvʭ;=ykYGK?endstream endobj 529 0 obj << /Filter /FlateDecode /Length 530 >> stream xSr@W̱E٣ٗ CRrpqJI1a>Cf$ @ u#aş#bOf+TX,QpFc *bF}.;t± k%bpsuvM;3+,#I֯vz_^˱_$}endstream endobj 530 0 obj << /Type /XRef /Length 411 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 531 /ID [] >> stream x+Da{13;ʌX())V,,?@bCa!%J,dbdB,F)_;M`,~=<9~eL:|58kBQ xk˶ۿtMm?蚖mkw:VK3gbVhWb»Xr Zb9QZ^qAκH$F ­Q+&VkO,AЫ''ڳ΄tv;x(!~͋xE40"& ;stB,ᡄ>^VD~).}zx$spt5NɇVG~s{I I='~3pt>;I??oOѳL."q+.f՜Vs *T endstream endobj startxref 332233 %%EOF seriation/inst/doc/seriation.Rnw0000644000176200001440000024023314066706641016474 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 archaeology. \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 criteria 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 deviations 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", prop = FALSE) @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered", prop = FALSE) @ \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 list of the available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= list_seriation_methods("dist") list_seriation_methods("matrix") @ To get detailed information on a seriation method use the following. <<>>= get_seriation_method("dist", name = "ARSA") @ 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", "New_Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "New_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. <<>>= list_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "New_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, row_labels = 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), row_labels = 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 @ In a newer version of the package this can be also done with the new heatmap seriation method for matrices. <<>>= get_seriation_method("matrix", name = "heatmap") o <- seriate(orig_matrix, method = "heatmap", dist_fun = function(d) dist(d, "minkowski", p = 1), seriation_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, panel = panel.tiles) @ 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, panel = panel.tiles) @ 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))), ] x_iris <- iris[, -5] d_iris <- dist(x_iris, 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_iris, method = NA) @ <>= ## plot reordered matrix dissplot(d_iris, 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(x_iris, 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_iris, labels = l, main = "Dissimilarity plot - standard") @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, main = "Dissimilarity plot - threshold", threshold = 3) 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 = 3)) @ 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(ruspini, 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/CITATION0000644000176200001440000000171414132440330014356 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 = "mhahsler@lyle.smu.edu"), 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", doi = "10.18637/jss.v025.i03", month = "March", issn = "1548-7660" ) bibentry(bibtype = "article", title = "An experimental comparison of seriation methods for one-mode two-way data", author = person("Michael", "Hahsler", email = "mhahsler@lyle.smu.edu"), year = 2017, journal = "European Journal of Operational Research", volume = 257, number = 1, pages = "133--143", doi = "10.1016/j.ejor.2016.08.066", month = "February" )