clue/0000755000175100001440000000000014503545506011227 5ustar hornikusersclue/NAMESPACE0000644000175100001440000002447214503541633012454 0ustar hornikusersuseDynLib("clue", .registration = TRUE, .fixes = "C_") import("stats") importFrom("graphics", "par", "plot") importFrom("cluster", "clara", "pam", "silhouette") export("cl_agreement", "cl_bag", "cl_boot", "cl_consensus", "cl_dissimilarity", "cl_ensemble", "as.cl_ensemble", "is.cl_ensemble", "cl_fuzziness", "cl_join", "cl_margin", "cl_meet", "cl_medoid", "cl_membership", "as.cl_membership", "cl_object_names", "cl_pam", "cl_pclust", "cl_predict", "cl_prototypes", "cl_tabulate", "cl_ultrametric", "as.cl_ultrametric", "ls_fit_addtree", "ls_fit_centroid", "ls_fit_ultrametric", "ls_fit_sum_of_ultrametrics", "ls_fit_ultrametric_target", "l1_fit_ultrametric", "l1_fit_ultrametric_target", "cl_validity", "n_of_objects", "n_of_classes", "cl_class_ids", "as.cl_class_ids", "cl_classes", "is.cl_partition", "as.cl_partition", "is.cl_hard_partition", "as.cl_hard_partition", "is.cl_soft_partition", "is.cl_dendrogram", "as.cl_dendrogram", "is.cl_hierarchy", "as.cl_hierarchy", "as.cl_addtree", "kmedoids", "pclust", "pclust_family", "pclust_object", "solve_LSAP", "sumt") ## S3 methods, sorted alphabetically. S3method("[", "cl_agreement") S3method("[", "cl_dissimilarity") S3method("[", "cl_ensemble") S3method("[", "cl_proximity") S3method("Complex", "cl_hierarchy") S3method("Complex", "cl_partition") S3method("Math", "cl_hierarchy") S3method("Math", "cl_partition") S3method("Ops", "cl_dendrogram") S3method("Ops", "cl_hierarchy") S3method("Ops", "cl_partition") S3method("Summary", "cl_hierarchy") S3method("Summary", "cl_partition") S3method("Summary", "cl_partition_ensemble") S3method("as.cl_addtree", "default") S3method("as.cl_addtree", "phylo") S3method("as.cl_membership", "default") S3method("as.cl_membership", "matrix") S3method("as.cl_ultrametric", "default") S3method("as.cl_ultrametric", "matrix") S3method("as.dendrogram", "cl_ultrametric") S3method("as.dist", "cl_dissimilarity") S3method("as.hclust", "cl_hierarchy") S3method("as.hclust", "cl_ultrametric") S3method("as.hclust", "mona") S3method("as.matrix", "cl_proximity") S3method("as.matrix", "hclust") S3method("c", "cl_ensemble") S3method("cl_class_ids", "Mclust") S3method("cl_class_ids", "Weka_clusterer") S3method("cl_class_ids", "bclust") S3method("cl_class_ids", "ccfkms") S3method("cl_class_ids", "cclust") S3method("cl_class_ids", "cl_class_ids") S3method("cl_class_ids", "cl_membership") S3method("cl_class_ids", "cl_pam") S3method("cl_class_ids", "cl_partition") S3method("cl_class_ids", "cl_partition_by_class_ids") S3method("cl_class_ids", "cshell") S3method("cl_class_ids", "default") S3method("cl_class_ids", "fclust") S3method("cl_class_ids", "flexmix") S3method("cl_class_ids", "kcca") S3method("cl_class_ids", "kmeans") S3method("cl_class_ids", "kmedoids") S3method("cl_class_ids", "movMF") S3method("cl_class_ids", "partition") S3method("cl_class_ids", "pclust") S3method("cl_class_ids", "relation") S3method("cl_class_ids", "rock") S3method("cl_class_ids", "specc") S3method("cl_classes", "cl_hierarchy") S3method("cl_classes", "cl_partition") S3method("cl_classes", "cl_ultrametric") S3method("cl_classes", "default") S3method("cl_membership", "Mclust") S3method("cl_membership", "bclust") S3method("cl_membership", "cclust") S3method("cl_membership", "cl_membership") S3method("cl_membership", "cl_partition") S3method("cl_membership", "cshell") S3method("cl_membership", "default") S3method("cl_membership", "fanny") S3method("cl_membership", "fclust") S3method("cl_membership", "flexmix") S3method("cl_membership", "kmeans") S3method("cl_membership", "movMF") S3method("cl_membership", "partition") S3method("cl_membership", "pclust") S3method("cl_object_names", "cl_ensemble") S3method("cl_object_names", "cl_hierarchy") S3method("cl_object_names", "cl_membership") S3method("cl_object_names", "cl_partition") S3method("cl_object_names", "cl_ultrametric") S3method("cl_object_names", "default") S3method("cl_object_names", "dist") S3method("cl_object_names", "hclust") S3method("cl_object_names", "mona") S3method("cl_object_names", "phylo") S3method("cl_object_names", "twins") S3method("cl_predict", "Mclust") S3method("cl_predict", "Weka_clusterer") S3method("cl_predict", "bclust") S3method("cl_predict", "cclust") S3method("cl_predict", "cl_partition") S3method("cl_predict", "ccfkms") S3method("cl_predict", "clara") S3method("cl_predict", "cshell") S3method("cl_predict", "default") S3method("cl_predict", "fanny") S3method("cl_predict", "fclust") S3method("cl_predict", "flexmix") S3method("cl_predict", "kcca") S3method("cl_predict", "kmeans") S3method("cl_predict", "movMF") S3method("cl_predict", "pam") S3method("cl_predict", "pclust") S3method("cl_predict", "rock") S3method("cl_prototypes", "Mclust") S3method("cl_prototypes", "bclust") S3method("cl_prototypes", "ccfkms") S3method("cl_prototypes", "cclust") S3method("cl_prototypes", "cl_pam") S3method("cl_prototypes", "cl_partition") S3method("cl_prototypes", "clara") S3method("cl_prototypes", "cshell") S3method("cl_prototypes", "fclust") S3method("cl_prototypes", "kcca") S3method("cl_prototypes", "kmeans") S3method("cl_prototypes", "pam") S3method("cl_prototypes", "pclust") S3method("cl_prototypes", "specc") S3method("cl_validity", "agnes") S3method("cl_validity", "default") S3method("cl_validity", "diana") S3method("cl_validity", "cl_partition") S3method("cl_validity", "pclust") S3method("cophenetic", "cl_ultrametric") S3method("cophenetic", "mona") S3method("cut", "cl_dendrogram") S3method("is.cl_dendrogram", "cl_dendrogram") S3method("is.cl_dendrogram", "default") S3method("is.cl_dendrogram", "hclust") S3method("is.cl_dendrogram", "mona") S3method("is.cl_dendrogram", "phylo") S3method("is.cl_dendrogram", "twins") S3method("is.cl_hard_partition", "Mclust") S3method("is.cl_hard_partition", "Weka_clusterer") S3method("is.cl_hard_partition", "bclust") S3method("is.cl_hard_partition", "ccfkms") S3method("is.cl_hard_partition", "cclust") S3method("is.cl_hard_partition", "cl_hard_partition") S3method("is.cl_hard_partition", "cl_partition") S3method("is.cl_hard_partition", "cshell") S3method("is.cl_hard_partition", "default") S3method("is.cl_hard_partition", "fanny") S3method("is.cl_hard_partition", "fclust") S3method("is.cl_hard_partition", "flexmix") S3method("is.cl_hard_partition", "kcca") S3method("is.cl_hard_partition", "kmeans") S3method("is.cl_hard_partition", "kmedoids") S3method("is.cl_hard_partition", "movMF") S3method("is.cl_hard_partition", "partition") S3method("is.cl_hard_partition", "pclust") S3method("is.cl_hard_partition", "rock") S3method("is.cl_hard_partition", "specc") S3method("is.cl_hierarchy", "cl_hierarchy") S3method("is.cl_hierarchy", "default") S3method("is.cl_hierarchy", "hclust") S3method("is.cl_hierarchy", "mona") S3method("is.cl_hierarchy", "phylo") S3method("is.cl_hierarchy", "twins") S3method("is.cl_partition", "Mclust") S3method("is.cl_partition", "Weka_clusterer") S3method("is.cl_partition", "bclust") S3method("is.cl_partition", "ccfkms") S3method("is.cl_partition", "cclust") S3method("is.cl_partition", "cl_partition") S3method("is.cl_partition", "cshell") S3method("is.cl_partition", "default") S3method("is.cl_partition", "fclust") S3method("is.cl_partition", "flexmix") S3method("is.cl_partition", "kcca") S3method("is.cl_partition", "kmeans") S3method("is.cl_partition", "kmedoids") S3method("is.cl_partition", "movMF") S3method("is.cl_partition", "partition") S3method("is.cl_partition", "pclust") S3method("is.cl_partition", "rock") S3method("is.cl_partition", "specc") S3method("n_of_classes", "Mclust") S3method("n_of_classes", "bclust") S3method("n_of_classes", "cclust") S3method("n_of_classes", "cl_membership") S3method("n_of_classes", "cl_partition") S3method("n_of_classes", "cshell") S3method("n_of_classes", "default") S3method("n_of_classes", "fanny") S3method("n_of_classes", "fclust") S3method("n_of_classes", "kmeans") S3method("n_of_classes", "partition") S3method("n_of_classes", "pclust") S3method("n_of_objects", "Mclust") S3method("n_of_objects", "bclust") S3method("n_of_objects", "cclust") S3method("n_of_objects", "cl_ensemble") S3method("n_of_objects", "cl_hierarchy") S3method("n_of_objects", "cl_membership") S3method("n_of_objects", "cl_partition") S3method("n_of_objects", "cl_ultrametric") S3method("n_of_objects", "cshell") S3method("n_of_objects", "default") S3method("n_of_objects", "dist") S3method("n_of_objects", "fclust") S3method("n_of_objects", "hclust") S3method("n_of_objects", "kmeans") S3method("n_of_objects", "mona") S3method("n_of_objects", "partition") S3method("n_of_objects", "pclust") S3method("n_of_objects", "phylo") S3method("n_of_objects", "twins") S3method("names", "cl_proximity") S3method("plot", "cl_addtree") S3method("plot", "cl_ensemble") S3method("plot", "cl_dendrogram") S3method("plot", "cl_ultrametric") S3method("print", "cl_class_ids") S3method("print", "cl_classes_of_partition_of_objects") S3method("print", "cl_classes_of_hierarchy_of_objects") S3method("print", "cl_cross_proximity") S3method("print", "cl_dendrogram") S3method("print", "cl_dendrogram_ensemble") S3method("print", "cl_ensemble") S3method("print", "cl_fuzziness") S3method("print", "cl_hierarchy") S3method("print", "cl_hierarchy_ensemble") S3method("print", "cl_membership") S3method("print", "cl_pam") S3method("print", "cl_partition") S3method("print", "cl_partition_by_class_ids") S3method("print", "cl_partition_by_memberships") S3method("print", "cl_partition_ensemble") S3method("print", "cl_proximity") S3method("print", "cl_pclust") S3method("print", "cl_validity") S3method("print", "kmedoids") S3method("print", "pclust") S3method("print", "solve_LSAP") S3method("rep", "cl_ensemble") S3method("silhouette", "cl_partition") S3method("silhouette", "cl_pclust") S3method("unique", "cl_ensemble") S3method(".maybe_is_proper_soft_partition", "Mclust") S3method(".maybe_is_proper_soft_partition", "cl_partition") S3method(".maybe_is_proper_soft_partition", "cshell") S3method(".maybe_is_proper_soft_partition", "default") S3method(".maybe_is_proper_soft_partition", "fanny") S3method(".maybe_is_proper_soft_partition", "fclust") S3method(".maybe_is_proper_soft_partition", "flexmix") S3method(".maybe_is_proper_soft_partition", "pclust") clue/.aspell/0000755000175100001440000000000012462665664012577 5ustar hornikusersclue/.aspell/clue.rds0000644000175100001440000000156312462665506014241 0ustar hornikuserseUz6 S";yu֬nwK)A}sF'$~?'^w_oK`eъF dvzť]q|~|9nBkSb:4QkID匦ѓ-n/QQh哥(!/)1hE&,R6[0,@t* -:,1j~W||RvHC gG=(BZAl yɈтw$ p2f,CZp$noܙb۹fNExwg[:К}d.gip2GpuBQ':׆/&J<RkA[kEG^ ؜.""Np՝ Lɬ (wf1{]7Π;x\Z#0tH`p-(+c0^}62}D*JYXk;iwIΝYYah9PprZ /ʩ8'^ ն ^\clue/.aspell/defaults.R0000644000175100001440000000023113142056061014502 0ustar hornikusersRd_files <- vignettes <- R_files <- description <- list(encoding = "UTF-8", language = "en", dictionaries = c("en_stats", "clue")) clue/data/0000755000175100001440000000000014503542731012135 5ustar hornikusersclue/data/Phonemes.rda0000644000175100001440000000152714503542731014410 0ustar hornikusersV[HTQLaCX(" "B6#FY "⇉E2)"zhKSKS2aFE "Q}D{{aI }9g^ƙ4 f8anf8i5<97ߛߜa=Ƈn{!;}!GCt'Xf,=>8б>U@:-@WNMtO?9|d"}iUCó=LȬu~ <ߗU ^5"29NM]&z+G=i%n FZg])N,{_|Q/ @JDmcu[Bsg|< "] Q/ ւ1{j_;W RUyk7_2x`rzQ/tF+<p>a>'x֡йG|d,WBo d^uf\JCkSi.u,{s@9LpO܀3|zWx:y}5~n~~0Q/vqT>uk'Jۗ?xB /tFܷD?Q?˴Dx`?W/tF+}{[['sN+3سw晗0"' a 71nKv!HYx܈Dy+QD "rx]I3II$IIUIetKm4 $|,ʙ VS* c,ʲ2a`Wzgծa{=zgױ;ۦ4ծٙQ󊓺I%)LU)$ z$)6$_&0+%Ԕ$Χ5sseIIPeLV`VD(Ds:ssr1ͬkf$2<dx-0;3N]|i3 ^}Ϲ;$DK;%ؒHpd$$ݒL$IlRi$JOB3I!~E#A&d 0UX!*Bf2ƬcƓt1ٕ6 #Ɉ $&LJI_x_0;ϫ&4cn-f9j&_TY7^NO# fG<щoYf۳{VՔսdmՉemۦ64wiwl`ژӷtnLlҧ<#B5Tn]y{ۧvN[3,Yv.y{u7.4YZvussm7w}\\t\ry:e'[L864'-,g{3n;%e0~&ٮ)=$w{RY)׉K̢^~&DD/2KI~ $'RNI'$suǭ$)1I=M'߯$'ջJؒIDZ%%$}I.4!%]%p]ė<$$o{I:z*OjO|IsI/%p)'%IvI.kIoYvI$Ԥw3<);ROco 'ddi&~*9NRMwI:JM&)=2NI'lU&ⓄI& 'tjhRg9O,II:䝲OLIIII$$&N$$Rt)>&'IMORLy )&hTd$I|$'"(He&clue/data/GVME.rda0000644000175100001440000000221514503542731013363 0ustar hornikusersX;LQgDLR-61Ja^?шca,̬lтF-?11j(⛙{W2Q[}3g𮣛GEXLDe3eZL#4-ZtѕQ|HȝKSHo=bo7-ӧkW}sW1O~9!ޑ#?CbX+&O ?[*><1aօܤ:cw⡮K4u_yrAV*ۙc8^_Wm:+խTN]5O?q?l uzvvM=T]3O{Bkh2,״tؙ͘'M卺a͌/o[*o CYVZF2>n!ݫcPv]z5w5tf՚MK\^#m%'1ҖlM6h]yay#ӾEhXMǡ^܆ R:A oR,KO]Cg{FT{_8Hv P`4 57H p(=d7v?Ts g9UfE]{Ou |.@ȏ}kSu ݇A6Ft|gp"S :z8(`!BCHgf$)#t&=7Xd }E T@>J8@ "/U@PWRDJк$> pCՀ h< mG@oUPgg}0\c` `€8B=^S|p >v& 070$*O7p0zyA\ޔFك}Ճ}V@}W F0k>қClB/4:"P + x|!X`#/l|(P$Dz@} <Rفy$"Xh _^n.^Ο|_DYPa-j W:$_[22S:;-Xt>t?)^keϤjYa|{1t\e%w k| 155*ۙLv *VX` ۷O5sM1}]!Z?X_7RPRޢ(+qdžuGFg[ЊԐ,{_|&% /=xoO9Wڅ{D%cyU"M[2 ,~emqč7u!TZ̖٢yE {R˞ƚƗyw ^zÞ%^+Ps鎇<`%p-jn|Wedn]3+"Kp ^^jkppYQY<Эq9:3nY9z[PwSc8H_{#u dpcܱ5-xS|[~Ǭ Umak C>P_ DSϵ]MlmQ1wYΪr;N{DpEo^ǝ;s!J޻Lsj-̛<$&a u. Fß3Fo_]éw#,\'ܖsZlBmb&6R"\b\]c6\wc"֛UgƝno<qP.^Pr>x /dL`Xѿw \mmufruUӯj.) #lA_*}6nH-.e{H[҈ ;B;05](eL]}x%9]*]AR8iEݭ=~-f W Y? ڱ%1, r3Zcl.Zx~S/AMx >S~Hݑ{/c.܅뷞~$ncbIQG=#@:2z=囇&Q8sT&hbyΩ +˴NwxY՞SG5k$֛212L,P+/kࡍΡwl)(k)oـX7t/jGpGM8HvJffMp龌+Fowwk\=:+;bÌ+q7Jl|ζGyT`폫PUf:@yf}\k:S9Cɨ/}y5=)(Q/xܫvZ#fqCt76nɲ:겖m4vF&oV|hB<^A"ymDM =2SYh\ꌭ(+㽸?5MurBV[1vbxJ1;9#6)uS-b$3Vڈ[eTsA#6gЌ"V=_=2T꣡c"[LCٚ Ǵʢ7oGkǢ=euBz׫V$!:ڐ=QK>d˗ RT7n廉h9;Q]<6A4Xz>e)`E¾P-}R'۰Hz";'v 5xx}}:DGJq pÑn<˰l^g:͎֙Ck.xJӌϣn:|o ZqU4|e[>*w3G:s>ʅ<}0kͩ 0JWpE ^fǠO箪w(=LO=d.sv"n {|U5=svMw=' xLJh'y&cv^8͓,QǕ+ziGnܹ++<""V*_+븆=}jK0}pĚ*x 34Ya 5ݨ4^wPXk~_mCcOG{1;xUAz0-)fhB{ `L5ntrPe+RXV<k<?4w=2i/b~,{r } ՋfZ㯕fAC=kߑ@:\UlpjξbwI{,w>^K7 /zd'p 'Ep[8 ۺ.S8S|֤ ڌe?Ͽw8 B:m5a4h#*>>zp[=nW_Ձb-s$aq*5Wt8nis|Lr)s\2Ģ fqU?P$/}!Y)􅇏"|7›-{3 ލU7,0}3M(=r%j?$j6aٮM^1K{I}}_\9Z^B]*}m߁Y-\0ƻ j[VǾFεHqFcXi#Mf/Q UeT_~'w> WXD4qi{rkp>vw},ue12]i_ 59bқُUgz"3>ijyېd0f|] ^}wםxj~_TNs36ǿu>Z6u7d,{{DZR1£P.Q~[`?iwmKݎ鯶iACmD s m΍2;tٽbqALןi&uT7NMG}ֆι!:l>)Q7GG%2,q̚ɢy+4Vǁ1EJI=(Ocuf^*t YԪy.ZZumAx!bƋ$5eJޡ,N7 ޯRR=$oE@Q*ʖ@VfpN;/?b=%pzW*Vz^nmm'%}h|7;r1;2Q5݈ZTi!1%c#< Ke8aLʹ@(0?5є AC?\h3[Lрg"'ш25ohP^WgQ7U5M7VeT֢l{pEǽ'WZz}nH:ڻz(B]%)fhHNhk$E&SxXvN*U8'z nXE >6X}u%S FQpqm9⨼Lri{`Oڐ"s; SaJJ <"-0:QGBCrzQ;4T3eG,Iafpr3m(s`#ޜ󅙭VܤH}gn8nʒ TLw?^gU_@e5gX,u=LyVe Q%dEcQ̖珉;QwGaQ% qys[qϯ.(>~ϥhƴ#{)wdv}LI\nh*q}J9~r׍"P5E{1*ZuYs^r\Z*Ƕ}E+ T(b:?uF]RArO5zC$؍h˱t2[N=M"$m\&_PR>>|0fLD99ꧪŘui?qFN}j.Zj`\uUU޺?QD^qw.u$+FMu@QվcTt<&`{VUu"5jtNRg yGMqΊJs8ˣK]6饸k_TUm~cLW4ɑCfa:PO6ko+lA\Ǚk8u\\ݟ<;s.~ ʨ{%+v%%d;>:h蘓A47+*jč%wa_yMιzw#]=T4td>o{\Ti7T)4?x=)A,)+PܣJEЬpkB(Ox9̸'V3|257ns}7Z/1J j0$}<(/{c Z;o~FƝG#;sh9?-ld1 6 Fgw>RsSo58LPU?9%00%LsCWM9>,~Q_W땖68rqq(%%%lㅵ8}2+zD9/J9 jo1K_}3yz З4 m5EB[j>gS2>s?C<U7_瀾wN4W7>){yj^WZx+Wj}?2W3]R+ޏ _Ph?-{{ |!;>|s@Mڦe7OK< */8Q#ƓЯ~Ꭽ F8 tu }ˇPE+<|նoa=o\U@_;^8É+?}WTSS_7! ~桼_y1J@OaCt#;wvl4gqKwFd:oڶ7z@$Jx-'!Iz׷p_Nz(U |8M":Ŵ |A~[+71}vVRn O=L~jK7 _rʟ^$q5/ `WiaZ쎰<}S59~s'pk+9?9åO*YW`>*}kWi@[8ݯ'˱Zދ| ʫ8O9AWUXW!CO> B6~]7Jx2pC]-SVB^<,@[$~I+!qbo{a,$ntߏ7}8}x ZI$Bdv49ZV1V{ԕA[y{țv0Ѷ 8I@4;Ms)&,aSԞUءW5p^IS]NЯn):4V +׈Ūk(+ѥF{E1z׭m0#|u?^9 tB>ЧMC; s 'rL; A/7yW/2> G-~^f#7ijp'mdt\S<:虬O=i ߶z䶷)q_b:KT=nct#v*Wm |SW7:"wtu gbb:Iu%oTHy3["/;@k(mi8NSx\yc~N9!~l!YyTQd =a$$_3cA߉=a|jvhe-?FVN& v_);`,#0}3bq^:;_Cܷ$ٸ=gB +/'E6x،Ɔ>M}ߞCKSvYGۃ I|oAb[ N5@Gϡu:牷DCv wjAZC؈311VRcC`;C/P}cInď̈צ yεw{>d/YB"3n;ǀ.-+&u,>M?:O0Y$~ u,Wgd@ԫAA+Q($Ҷ<:zMr<AROc0?@ۏ9K 'EQL.G#3͗uВWDQM$*fXnNxNG}c9h[n^C0=S!qz%Oykcth.&Y] -q׍Dߪd}l"*Y=ৎ,MQ3„Q!H~Ӫ!j)->&Î;#Nl3ף/:v H WJȟ2\O^5v'/nRV?FPy& u:;&Ӟ[HZ%f*}!f̍I/AFċ.Ui:M#+KH]M2I _O\%"$Uc],#X>A_QsTm^C#{_!ԡ}g,Ft0> b$YkI}Aꈞ84 ]n?A5W ,#r F6a'JCL~%R[$q+rMշ? tK:9'$udW|ӛhd:c-~5>lJAU`CzmV3W7kM\9O;O+Bh19 6]O$<@i鑃d}ƯI4?0ɋd읍yֈ+W"ۈ_ek.ny eW&z9O&qL]#=%A wdA?,N#'=K!kl_q=tɻTm⏐n'BCrz?C䷇X] ȟu%睑O>$&d4H=z(g ɂvwVI;9/\.'q{I=?WFwfSoZ55#0*3d%ozH2%Ozs_$l2l~C}}n  l|~c?{I4X; ̚7ݼY!cmwt+1Pyc%nuA^.zg|_`=O5O:Zê~hW%o9}ۡN !,1ԔEGG@>Q?1ag Vc=75zYU'A˔/?;_124ĆJ60,Ka6'"}w3бIM >}kd?p ЏUr!ciYʗGm{Go]Jg`):k|ӑ?.qa0>lz̗2XGZaE>M=g< kLtoHd4HdEqn~-̳K22R &gzpȝS7`|<ݮ{H<yc\QpLh{EPHvN t;(D.5) C_z.~tūA5w.eoU?Cv8Q 8]rʝqmxN̿ Ȉ'~tvx m*'Hޛ;ޞ_>uHpLp?q&*9uH*߀v -]_ZcS!$n[.| fG'a~H:7!W< IԭCĎ#KH~"7sqEARgs'rr^{~dN~Z#~u)A˒_G֙~c3Q$zتO׎=u0蓼mAp1g3s3+C&> )Yw'iXj?!Wm#D\yYR{ }3ߦ7#%k׉?Nx^5#NfǓ`~NH&џ:jfF]1d 8Ew3x̓pu /7/] ㅟ$bt -`都mAp}? xvBB]RI?,Ӄ!`GI=x*sNY\@wtao=?Vy[0x(PG +v pl{G/C?$N/½! bOfM@.'q57u)RWKC qFI8HZB^Ťx߅l/QJ'U^y.q9 Ri8 <>>>Ͽrօ+78 FY^1_+u.{$7_r y`]`oi+g"?\G[ҟdOclue/data/Kinship82_Consensus.rda0000644000175100001440000000143414503542731016446 0ustar hornikusersV?LQJ[d⬃&ŅAF&^Z1 3 , ! X*+ݻ{JMtr ~d:14-E4 gټdn67mH* ^gSWmO^blK28{e};'؎T6ƛsW"Wwv]l{X`^⎧kV[be3!C}sN(;|0 t.ż1a_nlj:+2AZ;%-:ogllpnhI) Z\heKFur- Ч.䢏*f%gSA,U\)IąmTdpxO P4Y*U+)Y1]r3.\[ruM[ ljc3j+d[fDQ*FZΗMبN8Q49@7;}3pϑkk^oS,fj^V${;Ǡ~/(Zcr{.Bk\{Zo@\_x`>- ^^U4`~@YBW`ğn4iPyiL++<WyRU DDwɉHHLMt*z.uvq13ߡ;\/qj\=s^ۍ8(sGT)cTyUE8t;:[GY=R~ _ɠ3_/k%w,mkzH.#gçVS2=Qx^MA$4H Y#PE2 |r=]M޾M@'Y.%3ɈXYs Es(L*n@JIY򈉭/)"~Ѝ ʏڛýEQ=(UڀU$P >lMP YCs;e^2|ӛJ+0_Z3^Uډ_ A 6)7@z([s :ʷS~UB"§/?H o:N1 ݾfPnqQF73bB3Լ@F]&i,fjq9H~NlFXZf6z \Jb38 IQ\~6}"9nq@ )ll!7ÿCn ]F5ۤοv} KbOlP'>K=GP6dp- VGvF70R`\R~-j3k$)_  6?,5$v =D;19,?fER*yZpkhaP~y_xA; { Z< o_D!芝#Q0_M+޻ [BbcثBjxBW'lj8iҁ}btؗ{-q 8v"I AdJ,b[iSp {U#AF0AsY+rX i#@Ʉ(~_i3D|+ (WEYՀ8CA+G (pr0Hc|&y#AD;&U'&\rʌ*2Aԉ br}4I0!uޝj_#$-zcT[ Ȩa+MaPxf~=Dt!aH \J R@TVT1WS~ d5Cl,E4r4D<9Qh#_;g7/w@}ިFvkX i]{uْ.옌nȶ"UiTvLP>}(EF=ؓRdb)8<,{xV&HkA"L" )&|Z@K Ӟۡ@Nic%Tdp$=ip^Pǽ1ځ0cra*ĤJC|?R.b'V^ζAyq8SK Vl9XLa>8ALzYSd"@F' 600`LwpHabay}%% 8i 5WNiCUūks'*#clue/data/CKME.rda0000644000175100001440000001152014503542731013343 0ustar hornikusers7zXZi"6!XK])TW"nRʟ$l9 |]ᵽT#Ȏ,!e-L5YSL.{XGspt:B$x0OkkWy0ZKRh2*FT<ߧK3f 1Sz7eRoJ $S*B( >O`3)o\#TX5Eh UwuRV䚾ΜaCcEw_ɯJ‘U B@Iv,\'Y6k3}:\%ͫN▼I*x{p9F3CKj\ Jߔ{|SͥKyhm7 & [|sOHX R`I8V,w87$Ei+7"cEW^1JfI'T_A`Hut^NcUy=WW)ͽ+nǮCsVs(lM `[6V <$uwQi-^)ÑIȈ<=>@gABVuy>,Bhw\Z-3|ҩHUu8\ >jEFxhI٢ܮɃ h8;qae Ƕj W6ַ:?vocng~.S*2ri3/q/8 Pr~Ut m5{tݢ2QݏS͛ {zLjԭ1kt͞!Z }g ?\4󸁧xxDQt(Kgn+_ofbbҐWs).8$X^%y="[%-ԓTHK#0I)59E}\QTZWx>v0~O6b{:o& dd1 ۈ40aPebJƦrVH=sp#C߾PZyw}z}qt܃`,8Ƿ@8Mw9b&ÿ\ɲp^!Orb@l gڛ*( 2M6e;f 9Iѷ1Ў)ˏp@\s/ԔGeB/уb$Y"ىQ.#>:\]:`&B]ys3_|41c'kqD¹Xޚ{lߥN飩4O. (6}{AMvS y'#?Zn{oJ<^eQr%`O┪x+x= Dջܯ| @e xr$&?%J)M%_;k@*{(/im.[j.UC w::<|a2}#˜1G-}sOz])+p;m?dB_)Ta/MY?-{]%5!I]c@i Bך7/QsErSAVM0/Ug6 M\C&9֊Clbp[78<NMiπ T e$p/UJUA Zu v#l^GD3&@ջ.o/Qv!T {R&[m A*#dQۼJ#6u:u_, g %ٯc)L ojww Vԉ bQ[/r3V`ŭL QfEd.u; YUxIւ[C%̅-Ql['-Is('rF0xċ*;cUve6#c#їnu a;cݦiNMk$ֵb+:1FkCy+ t \_kfRr8 +:?t! p)ꈟR<|Zu ,"Z!I<2q;ԷW5.9ָ;lNM7:aY ȅ(>{P%WHvi%z~]Ҡ"t hGKN';x ՞&Ԉ6mo[{ap}Qd-*ZȾ>psh3:ؔ)!:qa:Q4`B($*@c0X̀hp߯2[3[lXqrď ӟ zdf/l=NvvrD*͕9ڷ|&"EbK'>%q#8|za `RbZ|> A^}b|zY{LZc&:iX ux/ @SyH<,3H = pi;J.- 2_`d%I )7Y/A<[$`)~jZ0DoG翙U3K5/ˢbPh,"áFȆ%#FP\R[D€µ.OnZ2>" +k^e?K|"#N=RK-CXgFC7{D&7lM FVW催SqR)d"ˉ1e%20ϙ C !U_g΁E5<5R-\zr.rJ|$n:_, KwHW#4ս"ID#YU'N i`h먳恕:Z7aylİ{?B3(L,r\EO*SsCcRi:"(]z76GNdO.3t):T尶/* s )E/*E.--Zh׀; !Gr`K:&j69 `a8CHZ) 2?ߊh>-_wu܋`@xRB9(;[Uc2F]_^S)YX_˲πK ?o*mtg8'4"E xC$9=wP'l0b>(ACS4Cqқoԝl(_vd c@<3 q͛H,1w҅x!CӁ噺QI3JGrX&{(y!K$Ut Ҋ kYq|z/蝢'L_RfSDE//{ bX/J';iQ .t.x4u-YL"~21( c !0F9락1hm>[z82{z]l"m>Z:AP\%,AEY㖚/<@х8Ɩ9 5 f-]9e[ޫQdn T!wtj=hx\GT45_2Q)[y] P%1̬莦Ԡ9=^STj7!sr)rv*]ִϽrBف!ز:理'\֭[ZЄ Uʲi4r+18R,*2Ĉg 9ouĨ&LKɹ0[B>s98t ( ||OZ6ky֬k򮘝|Ε6 6 @ 8٫tnACGd٠Br]u }OrF!_~9(۔n͌k0o\<i!lleQO 2+u2N}-*ulW}ы/b+PjWEhBo:R4;ۺ8J}+"\F1!*RH5]̲sj {7/>{C3'UXL+g@DaA_7 s_)rAZ6`+k[m[>9D/Y|~&Te8ڏԼΘ)ۑdo$<$ɢ)& |>0 YZclue/man/0000755000175100001440000000000012734172047012002 5ustar hornikusersclue/man/sumt.Rd0000644000175100001440000000670012734174226013265 0ustar hornikusers\name{sumt} \alias{sumt} \title{Sequential Unconstrained Minimization Technique} \description{ Solve constrained optimization problems via the Sequential Unconstrained Minimization Technique (\acronym{SUMT}). } \usage{ sumt(x0, L, P, grad_L = NULL, grad_P = NULL, method = NULL, eps = NULL, q = NULL, verbose = NULL, control = list()) } \arguments{ \item{x0}{a list of starting values, or a single starting value.} \item{L}{a function to minimize.} \item{P}{a non-negative penalty function such that \eqn{P(x)} is zero iff the constraints are satisfied.} \item{grad_L}{a function giving the gradient of \code{L}, or \code{NULL} (default).} \item{grad_P}{a function giving the gradient of \code{P}, or \code{NULL} (default).} \item{method}{a character string, or \code{NULL}. If not given, \code{"CG"} is used. If equal to \code{"nlm"}, minimization is carried out using \code{\link[stats]{nlm}}. Otherwise, \code{\link[stats]{optim}} is used with \code{method} as the given method.} \item{eps}{the absolute convergence tolerance. The algorithm stops if the (maximum) distance between successive \code{x} values is less than \code{eps}. Defaults to \code{sqrt(.Machine$double.eps)}.} \item{q}{a double greater than one controlling the growth of the \eqn{\rho_k} as described in \bold{Details}. Defaults to 10.} \item{verbose}{a logical indicating whether to provide some output on minimization progress. Defaults to \code{getOption("verbose")}.} \item{control}{a list of control parameters to be passed to the minimization routine in case \code{optim} is used.} } \details{ The Sequential Unconstrained Minimization Technique is a heuristic for constrained optimization. To minimize a function \eqn{L} subject to constraints, one employs a non-negative function \eqn{P} penalizing violations of the constraints, such that \eqn{P(x)} is zero iff \eqn{x} satisfies the constraints. One iteratively minimizes \eqn{L(x) + \rho_k P(x)}, where the \eqn{\rho} values are increased according to the rule \eqn{\rho_{k+1} = q \rho_k} for some constant \eqn{q > 1}, until convergence is obtained in the sense that the Euclidean distance between successive solutions \eqn{x_k} and \eqn{x_{k+1}} is small enough. Note that the \dQuote{solution} \eqn{x} obtained does not necessarily satisfy the constraints, i.e., has zero \eqn{P(x)}. Note also that there is no guarantee that global (approximately) constrained optima are found. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the algorithm. The unconstrained minimizations are carried out by either \code{\link[stats]{optim}} or \code{\link[stats]{nlm}}, using analytic gradients if both \code{grad_L} and \code{grad_P} are given, and numeric ones otherwise. If more than one starting value is given, the solution with the minimal augmented criterion function value is returned. } \value{ A list inheriting from class \code{"sumt"}, with components \code{x}, \code{L}, \code{P}, and \code{rho} giving the solution obtained, the value of the criterion and penalty function at \code{x}, and the final \eqn{\rho} value used in the augmented criterion function. } \references{ A. V. Fiacco and G. P. McCormick (1968). \emph{Nonlinear programming: Sequential unconstrained minimization techniques}. New York: John Wiley & Sons. } \keyword{optimize} clue/man/ls_fit_sum_of_ultrametrics.Rd0000644000175100001440000000603012116170572017711 0ustar hornikusers\name{ls_fit_sum_of_ultrametrics} \alias{ls_fit_sum_of_ultrametrics} \title{Least Squares Fit of Sums of Ultrametrics to Dissimilarities} \description{ Find a sequence of ultrametrics with sum minimizing square distance (Euclidean dissimilarity) to a given dissimilarity object. } \usage{ ls_fit_sum_of_ultrametrics(x, nterms = 1, weights = 1, control = list()) } \arguments{ \item{x}{a dissimilarity object inheriting from or coercible to class \code{"\link{dist}"}.} \item{nterms}{an integer giving the number of ultrametrics to be fitted.} \item{weights}{a numeric vector or matrix with non-negative weights for obtaining a weighted least squares fit. If a matrix, its numbers of rows and columns must be the same as the number of objects in \code{x}, and the lower diagonal part is used. Otherwise, it is recycled to the number of elements in \code{x}.} \item{control}{a list of control parameters. See \bold{Details}.} } \details{ The problem to be solved is minimizing the criterion function \deqn{L(u(1), \dots, u(n)) = \sum_{i,j} w_{ij} \left(x_{ij} - \sum_{k=1}^n u_{ij}(k)\right)^2}{ L(u(1), \dots, u(n)) = \sum_{i,j} w_{ij} \left(x_{ij} - \sum_{k=1}^n u_{ij}(k)\right)^2} over all \eqn{u(1), \ldots, u(n)} satisfying the ultrametric constraints. We provide an implementation of the iterative heuristic suggested in Carroll & Pruzansky (1980) which in each step \eqn{t} sequentially refits the \eqn{u(k)} as the least squares ultrametric fit to the \dQuote{residuals} \eqn{x - \sum_{l \ne k} u(l)} using \code{\link{ls_fit_ultrametric}}. Available control parameters include \describe{ \item{\code{maxiter}}{an integer giving the maximal number of iteration steps to be performed. Defaults to 100.} \item{\code{eps}}{a nonnegative number controlling the iteration, which stops when the maximal change in all \eqn{u(k)} is less than \code{eps}. Defaults to \eqn{10^{-6}}.} \item{\code{reltol}}{the relative convergence tolerance. Iteration stops when the relative change in the criterion function is less than \code{reltol}. Defaults to \eqn{10^{-6}}.} \item{\code{method}}{a character string indicating the fitting method to be employed by the individual least squares fits.} \item{\code{control}}{a list of control parameters to be used by the method of \code{\link{ls_fit_ultrametric}} employed. By default, if the \acronym{SUMT} method method is used, 10 inner \acronym{SUMT} runs are performed for each refitting.} } It should be noted that the method used is a heuristic which can not be guaranteed to find the global minimum. } \value{ A list of objects of class \code{"\link{cl_ultrametric}"} containing the fitted ultrametric distances. } \references{ J. D. Carroll and S. Pruzansky (1980). Discrete and hybrid scaling models. In E. D. Lantermann and H. Feger (eds.), \emph{Similarity and Choice}. Bern (Switzerland): Huber. } \keyword{cluster} \keyword{optimize} clue/man/Kinship82.Rd0000644000175100001440000000352014323456600014044 0ustar hornikusers\name{Kinship82} \alias{Kinship82} \title{Rosenberg-Kim Kinship Terms Partition Data} \description{ Partitions of 15 kinship terms given by 85 female undergraduates at Rutgers University who were asked to sort the terms into classes \dQuote{on the basis of some aspect of meaning}. } \usage{data("Kinship82")} \format{ A cluster ensemble of 85 hard partitions of the 15 kinship terms. } \details{ Rosenberg and Kim (1975) describe an experiment where perceived similarities of the kinship terms were obtained from six different \dQuote{sorting} experiments. These \dQuote{original} Rosenberg-Kim kinship terms data were published in Arabie, Carroll and de Sarbo (1987), and are also contained in file \file{indclus.data} in the shell archive \url{https://netlib.org/mds/indclus.shar}. For one of the experiments, partitions of the terms were printed in Rosenberg (1982). Comparison with the original data indicates that the partition data have the \dQuote{nephew} and \dQuote{niece} columns interchanged, which is corrected in the data set at hand. } \source{ Table 7.1 in Rosenberg (1982), with the \dQuote{nephew} and \dQuote{niece} columns interchanged. } \references{ P. Arabie, J. D. Carroll and W. S. de Sarbo (1987). \emph{Three-way scaling and clustering}. Newbury Park, CA: Sage. S. Rosenberg and M. P. Kim (1975). The method of sorting as a data-gathering procedure in multivariate research. \emph{Multivariate Behavioral Research}, \bold{10}, 489--502. \cr \doi{10.1207/s15327906mbr1004_7}. S. Rosenberg (1982). The method of sorting in multivariate research with applications selected from cognitive psychology and person perception. In N. Hirschberg and L. G. Humphreys (eds.), \emph{Multivariate Applications in the Social Sciences}, 117--142. Hillsdale, NJ: Erlbaum. } \keyword{datasets} clue/man/l1_fit_ultrametric.Rd0000644000175100001440000001111313140644252016051 0ustar hornikusers\name{l1_fit_ultrametric} \alias{l1_fit_ultrametric} \title{Least Absolute Deviation Fit of Ultrametrics to Dissimilarities} \description{ Find the ultrametric with minimal absolute distance (Manhattan dissimilarity) to a given dissimilarity object. } \usage{ l1_fit_ultrametric(x, method = c("SUMT", "IRIP"), weights = 1, control = list()) } \arguments{ \item{x}{a dissimilarity object inheriting from or coercible to class \code{"\link{dist}"}.} \item{method}{a character string indicating the fitting method to be employed. Must be one of \code{"SUMT"} (default) or \code{"IRIP"}, or a unique abbreviation thereof.} \item{weights}{a numeric vector or matrix with non-negative weights for obtaining a weighted least squares fit. If a matrix, its numbers of rows and columns must be the same as the number of objects in \code{x}, and the lower diagonal part is used. Otherwise, it is recycled to the number of elements in \code{x}.} \item{control}{a list of control parameters. See \bold{Details}.} } \value{ An object of class \code{"\link{cl_ultrametric}"} containing the fitted ultrametric distances. } \details{ The problem to be solved is minimizing \deqn{L(u) = \sum_{i,j} w_{ij} |x_{ij} - u_{ij}|} over all \eqn{u} satisfying the ultrametric constraints (i.e., for all \eqn{i, j, k}, \eqn{u_{ij} \le \max(u_{ik}, u_{jk})}). This problem is known to be NP hard (Krivanek and Moravek, 1986). We provide two heuristics for solving this problem. Method \code{"SUMT"} implements a \acronym{SUMT} (Sequential Unconstrained Minimization Technique, see \code{\link{sumt}}) approach using the sign function for the gradients of the absolute value function. Available control parameters are \code{method}, \code{control}, \code{eps}, \code{q}, and \code{verbose}, which have the same roles as for \code{\link{sumt}}, and the following. \describe{ \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{start}}{a single dissimilarity, or a list of dissimilarities to be employed as starting values.} } Method \code{"IRIP"} implements a variant of the Iteratively Reweighted Iterative Projection approach of Smith (2001), which attempts to solve the \eqn{L_1} problem via a sequence of weighted \eqn{L_2} problems, determining \eqn{u(t+1)} by minimizing the criterion function \deqn{\sum_{i,j} w_{ij} (x_{ij} - u_{ij})^2 / \max(|x_{ij} - u_{ij}(t)|, m)} with \eqn{m} a \dQuote{small} non-zero value to avoid zero divisors. We use the \acronym{SUMT} method of \code{\link{ls_fit_ultrametric}} for solving the weighted least squares problems. Available control parameters are as follows. \describe{ \item{\code{maxiter}}{an integer giving the maximal number of iteration steps to be performed. Defaults to 100.} \item{\code{eps}}{a nonnegative number controlling the iteration, which stops when the maximal change in \eqn{u} is less than \code{eps}. Defaults to \eqn{10^{-6}}.} \item{\code{reltol}}{the relative convergence tolerance. Iteration stops when the relative change in the \eqn{L_1} criterion is less than \code{reltol}. Defaults to \eqn{10^{-6}}.} \item{\code{MIN}}{the cutoff \eqn{m}. Defaults to \eqn{10^{-3}}.} \item{\code{start}}{a dissimilarity object to be used as the starting value for \eqn{u}.} \item{\code{control}}{a list of control parameters to be used by the method of \code{\link{ls_fit_ultrametric}} employed for solving the weighted \eqn{L_2} problems.} } One may need to adjust the default control parameters to achieve convergence. It should be noted that all methods are heuristics which can not be guaranteed to find the global minimum. } \seealso{ \code{\link{cl_consensus}} for computing least absolute deviation (Manhattan) consensus hierarchies; \code{\link{ls_fit_ultrametric}}. } \references{ M. Krivanek and J. Moravek (1986). NP-hard problems in hierarchical tree clustering. \emph{Acta Informatica}, \bold{23}, 311--323. \doi{10.1007/BF00289116}. T. J. Smith (2001). Constructing ultrametric and additive trees based on the \eqn{L_1} norm. \emph{Journal of Classification}, \bold{18}, 185--207. \url{https://link.springer.com/article/10.1007/s00357-001-0015-0}. %% The above web page has %% \doi{10.1007/s00357-001-0015-0}. %% which does not work. Reported to the responsible DOI Registration %% Agency on 2017-08-03, let's use the URL instead of the DOI for now. } \keyword{cluster} \keyword{optimize} clue/man/lattice.Rd0000644000175100001440000001235614021342636013717 0ustar hornikusers\name{lattice} \encoding{UTF-8} \alias{cl_meet} \alias{cl_join} \alias{Ops.cl_partition} \alias{Summary.cl_partition} \alias{Ops.cl_dendrogram} \alias{Ops.cl_hierarchy} \alias{Summary.cl_hierarchy} \title{Cluster Lattices} \description{ Computations on the lattice of all (hard) partitions, or the lattice of all dendrograms, or the meet semilattice of all hierarchies (\eqn{n}-trees) of/on a set of objects: meet, join, and comparisons. } \usage{ cl_meet(x, y) cl_join(x, y) } \arguments{ \item{x}{an ensemble of partitions or dendrograms or hierarchies, or an R object representing a partition or dendrogram or hierarchy.} \item{y}{an R object representing a partition or dendrogram or hierarchy. Ignored if \code{x} is an ensemble.} } \details{ For a given finite set of objects \eqn{X}, the set \eqn{H(X)} of all (hard) partitions of \eqn{X} can be partially ordered by defining a partition \eqn{P} to be \dQuote{finer} than a partition \eqn{Q}, i.e., \eqn{P \le Q}, if each class of \eqn{P} is contained in some class of \eqn{Q}. With this partial order, \eqn{H(X)} becomes a bounded \dfn{lattice}, with intersection and union of two elements given by their greatest lower bound (\dfn{meet}) and their least upper bound (\dfn{join}), respectively. Specifically, the meet of two partitions computed by \code{cl_meet} is the partition obtained by intersecting the classes of the partitions; the classes of the join computed by \code{cl_join} are obtained by joining all elements in the same class in at least one of the partitions. Obviously, the least and greatest elements of the partition lattice are the partitions where each object is in a single class (sometimes referred to as the \dQuote{splitter} partition) or in the same class (the \dQuote{lumper} partition), respectively. Meet and join of an arbitrary number of partitions can be defined recursively. In addition to computing the meet and join, the comparison operations corresponding to the above partial order as well as \code{min}, \code{max}, and \code{range} are available at least for R objects representing partitions inheriting from \code{"\link{cl_partition}"}. The summary methods give the meet and join of the given partitions (for \code{min} and \code{max}), or a partition ensemble with the meet and join (for \code{range}). If the partitions specified by \code{x} and \code{y} are soft partitions, the corresponding nearest hard partitions are used. Future versions may optionally provide suitable \dQuote{soft} (fuzzy) extensions for computing meets and joins. The set of all dendrograms on \eqn{X} can be ordered using pointwise inequality of the associated ultrametric dissimilarities: i.e., if \eqn{D} and \eqn{E} are the dendrograms with ultrametrics \eqn{u} and \eqn{v}, respectively, then \eqn{D \le E} if \eqn{u_{ij} \le v_{ij}} for all pairs \eqn{(i, j)} of objects. This again yields a lattice (of dendrograms). The join of \eqn{D} and \eqn{E} is the dendrogram with ultrametrics given by \eqn{\max(u_{ij}, v_{ij})} (as this gives an ultrametric); the meet is the dendrogram with the maximal ultrametric dominated by \eqn{\min(u_{ij}, v_{ij})}, and can be obtained by applying single linkage hierarchical clustering to the minima. The set of all hierarchies on \eqn{X} can be ordered by set-wise inclusion of the classes: i.e., if \eqn{H} and \eqn{G} are two hierarchies, then \eqn{H \le G} if all classes of \eqn{H} are also classes of \eqn{G}. This yields a meet semilattice, with meet given by the classes contained in both hierarchies. The join only exists if the union of the classes is a hierarchy. In each case, a modular semilattice is obtained, which allows for a natural metrization via least element (semi)lattice move distances, see Barthélémy, Leclerc and Monjardet (1981). These latticial metrics are given by the BA/C (partitions), Manhattan (dendrograms), and symdiff (hierarchies) dissimilarities, respectively (see \code{\link{cl_dissimilarity}}). } \value{ For \code{cl_meet} and \code{cl_join}, an object of class \code{"\link{cl_partition}"} or \code{"\link{cl_dendrogram}"} with the class ids or ultrametric dissimilarities of the meet and join of the partitions or dendrograms, respectively. } \references{ J.-P. Barthélémy, B. Leclerc and B. Monjardet (1981). On the use of ordered sets in problems of comparison and consensus of classification. \emph{Journal of Classification}, \bold{3}, 187--224. \doi{10.1007/BF01894188}. } \examples{ ## Two simple partitions of 7 objects. A <- as.cl_partition(c(1, 1, 2, 3, 3, 5, 5)) B <- as.cl_partition(c(1, 2, 2, 3, 4, 5, 5)) ## These disagree on objects 1-3, A splits objects 4 and 5 into ## separate classes. Objects 6 and 7 are always in the same class. (A <= B) || (B <= A) ## (Neither partition is finer than the other.) cl_meet(A, B) cl_join(A, B) ## Meeting with the lumper (greatest) or joining with the splitter ## (least) partition does not make a difference: C_lumper <- as.cl_partition(rep(1, n_of_objects(A))) cl_meet(cl_ensemble(A, B, C_lumper)) C_splitter <- as.cl_partition(seq_len(n_of_objects(A))) cl_join(cl_ensemble(A, B, C_splitter)) ## Another way of computing the join: range(A, B, C_splitter)$max } \keyword{cluster} clue/man/GVME.Rd0000644000175100001440000000207412734171420013024 0ustar hornikusers\name{GVME} \alias{GVME} \title{Gordon-Vichi Macroeconomic Partition Ensemble Data} \description{ Soft partitions of 21 countries based on macroeconomic data for the years 1975, 1980, 1985, 1990, and 1995. } \usage{data("GVME")} \format{ A named cluster ensemble of 5 soft partitions of 21 countries into 2 or 3 classes. The names are the years to which the partitions correspond. } \details{ The partitions were obtained using fuzzy \eqn{c}-means on measurements of the following variables: the annual per capita gross domestic product (GDP) in USD (converted to 1987 prices); the percentage of GDP provided by agriculture; the percentage of employees who worked in agriculture; and gross domestic investment, expressed as a percentage of the GDP. See Gordon and Vichi (2001), page 230, for more details. } \source{ Table 1 in Gordon and Vichi (2001). } \references{ A. D. Gordon and M. Vichi (2001). Fuzzy partition models for fitting a set of partitions. \emph{Psychometrika}, \bold{66}, 229--248. \doi{10.1007/BF02294837}. } \keyword{datasets} clue/man/cl_validity.Rd0000644000175100001440000000674113140644223014574 0ustar hornikusers\name{cl_validity} \alias{cl_validity} \alias{cl_validity.default} \title{Validity Measures for Partitions and Hierarchies} \description{ Compute validity measures for partitions and hierarchies, attempting to measure how well these clusterings capture the underlying structure in the data they were obtained from. } \usage{ cl_validity(x, ...) \method{cl_validity}{default}(x, d, ...) } \arguments{ \item{x}{an object representing a partition or hierarchy.} \item{d}{a dissimilarity object from which \code{x} was obtained.} \item{\dots}{arguments to be passed to or from methods.} } \value{ A list of class \code{"cl_validity"} with the computed validity measures. } \details{ \code{cl_validity} is a generic function. For partitions, its default method gives the \dQuote{dissimilarity accounted for}, defined as \eqn{1 - a_w / a_t}, where \eqn{a_t} is the average total dissimilarity, and the \dQuote{average within dissimilarity} \eqn{a_w} is given by \deqn{\frac{\sum_{i,j} \sum_k m_{ik}m_{jk} d_{ij}}{ \sum_{i,j} \sum_k m_{ik}m_{jk}}}{% \sum_{i,j} \sum_k m_{ik}m_{jk} d_{ij} / \sum_{i,j} \sum_k m_{ik}m_{jk}} where \eqn{d} and \eqn{m} are the dissimilarities and memberships, respectively, and the sums are over all pairs of objects and all classes. For hierarchies, the validity measures computed by default are \dQuote{variance accounted for} (VAF, e.g., Hubert, Arabie & Meulman, 2006) and \dQuote{deviance accounted for} (DEV, e.g., Smith, 2001). If \code{u} is the ultrametric corresponding to the hierarchy \code{x} and \code{d} the dissimilarity \code{x} was obtained from, these validity measures are given by \deqn{\mathrm{VAF} = \max\left(0, 1 - \frac{\sum_{i,j} (d_{ij} - u_{ij})^2}{ \sum_{i,j} (d_{ij} - \mathrm{mean}(d)) ^ 2}\right)}{ max(0, 1 - sum_{i,j} (d_{ij} - u_{ij})^2 / sum_{i,j} (d_{ij} - mean(d))^2)} and \deqn{\mathrm{DEV} = \max\left(0, 1 - \frac{\sum_{i,j} |d_{ij} - u_{ij}|}{ \sum_{i,j} |d_{ij} - \mathrm{median}(d)|}\right)}{ max(0, 1 - sum_{i,j} |d_{ij} - u_{ij}| / sum_{i,j} |d_{ij} - median(d)|)} respectively. Note that VAF and DEV are not invariant under rescaling \code{u}, and may be \dQuote{arbitrarily small} (i.e., 0 using the above definitions) even though \code{u} and \code{d} are \dQuote{structurally close} in some sense. For the results of using \code{\link[cluster]{agnes}} and \code{\link[cluster]{diana}}, the agglomerative and divisive coefficients are provided in addition to the default ones. } \references{ L. Hubert, P. Arabie and J. Meulman (2006). \emph{The structural representation of proximity matrices with MATLAB}. Philadelphia, PA: SIAM. T. J. Smith (2001). Constructing ultrametric and additive trees based on the \eqn{L_1} norm. \emph{Journal of Classification}, \bold{18}/2, 185--207. \url{https://link.springer.com/article/10.1007/s00357-001-0015-0}. %% The above web page has %% \doi{10.1007/s00357-001-0015-0}. %% which does not work. Reported to the responsible DOI Registration %% Agency on 2017-08-03, let's use the URL instead of the DOI for now. } \seealso{ \code{\link[fpc]{cluster.stats}} in package \pkg{fpc} for a variety of cluster validation statistics; \code{\link[e1071]{fclustIndex}} in package \pkg{e1071} for several fuzzy cluster indexes; \code{\link[cclust:Rindexes]{clustIndex}} in package \pkg{cclust}; \code{\link[cluster]{silhouette}} in package \pkg{cluster}. } \keyword{cluster} clue/man/addtree.Rd0000644000175100001440000000364312037226501013676 0ustar hornikusers\name{addtree} \encoding{UTF-8} \alias{as.cl_addtree} \title{Additive Tree Distances} \description{ Objects representing additive tree distances. } \usage{ as.cl_addtree(x) } \arguments{ \item{x}{an R object representing additive tree distances.} } \value{ An object of class \code{"cl_addtree"} containing the additive tree distances. } \details{ Additive tree distances are object dissimilarities \eqn{d} satisfying the so-called \emph{additive tree conditions}, also known as \emph{four-point conditions} \eqn{d_{ij} + d_{kl} \le \max(d_{ik} + d_{jl}, d_{il} + d_{jk})} for all quadruples \eqn{i, j, k, l}. Equivalently, for each such quadruple, the largest two values of the sums \eqn{d_{ij} + d_{kl}}, \eqn{d_{ik} + d_{jl}}, and \eqn{d_{il} + d_{jk}} must be equal. Centroid distances are additive tree distances where the inequalities in the four-point conditions are strengthened to equalities (such that all three sums are equal), and can be represented as \eqn{d_{ij} = g_i + g_j}, i.e., as sums of distances from a \dQuote{centroid}. See, e.g., Barthélémy and Guénoche (1991) for more details on additive tree distances. \code{as.cl_addtree} is a generic function. Its default method can handle objects representing ultrametric distances and raw additive distance matrices. In addition, there is a method for coercing objects of class \code{"\link[ape:as.phylo]{phylo}"} from package \pkg{ape}. Functions \code{\link{ls_fit_addtree}} and \code{\link{ls_fit_centroid}} can be used to find the additive tree distance or centroid distance minimizing least squares distance (Euclidean dissimilarity) to a given dissimilarity object. There is a \code{\link{plot}} method for additive tree distances. } \references{ J.-P. Barthélémy and A. Guénoche (1991). \emph{Trees and proximity representations}. Chichester: John Wiley & Sons. ISBN 0-471-92263-3. } \keyword{cluster} clue/man/cl_consensus.Rd0000644000175100001440000003671214503010223014757 0ustar hornikusers\name{cl_consensus} \alias{cl_consensus} \title{Consensus Partitions and Hierarchies} \description{ Compute the consensus clustering of an ensemble of partitions or hierarchies. } \usage{ cl_consensus(x, method = NULL, weights = 1, control = list()) } \arguments{ \item{x}{an ensemble of partitions or hierarchies, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{method}{a character string specifying one of the built-in methods for computing consensus clusterings, or a function to be taken as a user-defined method, or \code{NULL} (default value). If a character string, its lower-cased version is matched against the lower-cased names of the available built-in methods using \code{\link{pmatch}}. See \bold{Details} for available built-in methods and defaults.} \item{weights}{a numeric vector with non-negative case weights. Recycled to the number of elements in the ensemble given by \code{x} if necessary.} \item{control}{a list of control parameters. See \bold{Details}.} } \value{ The consensus partition or hierarchy. } \details{ Consensus clusterings \dQuote{synthesize} the information in the elements of a cluster ensemble into a single clustering, often by minimizing a criterion function measuring how dissimilar consensus candidates are from the (elements of) the ensemble (the so-called \dQuote{optimization approach} to consensus clustering). The most popular criterion functions are of the form \eqn{L(x) = \sum w_b d(x_b, x)^p}, where \eqn{d} is a suitable dissimilarity measure (see \code{\link{cl_dissimilarity}}), \eqn{w_b} is the case weight given to element \eqn{x_b} of the ensemble, and \eqn{p \ge 1}. If \eqn{p = 1} and minimization is over all possible base clusterings, a consensus solution is called a \emph{median} of the ensemble; if minimization is restricted to the elements of the ensemble, a consensus solution is called a \emph{medoid} (see \code{\link{cl_medoid}}). For \eqn{p = 2}, we obtain \emph{least squares} consensus partitions and hierarchies (generalized means). See also Gordon (1999) for more information. If all elements of the ensemble are partitions, the built-in consensus methods compute consensus partitions by minimizing a criterion of the form \eqn{L(x) = \sum w_b d(x_b, x)^p} over all hard or soft partitions \eqn{x} with a given (maximal) number \eqn{k} of classes. Available built-in methods are as follows. \describe{ \item{\code{"SE"}}{a fixed-point algorithm for obtaining \emph{soft} least squares Euclidean consensus partitions (i.e., for minimizing \eqn{L} with Euclidean dissimilarity \eqn{d} and \eqn{p = 2} over all soft partitions with a given maximal number of classes). This iterates between individually matching all partitions to the current approximation to the consensus partition, and computing the next approximation as the membership matrix closest to a suitable weighted average of the memberships of all partitions after permuting their columns for the optimal matchings of class ids. The following control parameters are available for this method. \describe{ \item{\code{k}}{an integer giving the number of classes to be used for the least squares consensus partition. By default, the maximal number of classes in the ensemble is used.} \item{\code{maxiter}}{an integer giving the maximal number of iterations to be performed. Defaults to 100.} \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{reltol}}{the relative convergence tolerance. Defaults to \code{sqrt(.Machine$double.eps)}.} \item{\code{start}}{a matrix with number of rows equal to the number of objects of the cluster ensemble, and \eqn{k} columns, to be used as a starting value, or a list of such matrices. By default, suitable random membership matrices are used.} \item{\code{verbose}}{a logical indicating whether to provide some output on minimization progress. Defaults to \code{getOption("verbose")}.} } In the case of multiple runs, the first optimum found is returned. This method can also be referred to as \code{"soft/euclidean"}. } \item{\code{"GV1"}}{the fixed-point algorithm for the \dQuote{first model} in Gordon and Vichi (2001) for minimizing \eqn{L} with \eqn{d} being GV1 dissimilarity and \eqn{p = 2} over all soft partitions with a given maximal number of classes. This is similar to \code{"SE"}, but uses GV1 rather than Euclidean dissimilarity. Available control parameters are the same as for \code{"SE"}. } \item{\code{"DWH"}}{an extension of the greedy algorithm in Dimitriadou, Weingessel and Hornik (2002) for (approximately) obtaining soft least squares Euclidean consensus partitions. The reference provides some structure theory relating finding the consensus partition to an instance of the multiple assignment problem, which is known to be NP-hard, and suggests a simple heuristic based on successively matching an individual partition \eqn{x_b} to the current approximation to the consensus partition, and compute the memberships of the next approximation as a weighted average of those of the current one and of \eqn{x_b} after permuting its columns for the optimal matching of class ids. The following control parameters are available for this method. \describe{ \item{\code{k}}{an integer giving the number of classes to be used for the least squares consensus partition. By default, the maximal number of classes in the ensemble is used.} \item{\code{order}}{a permutation of the integers from 1 to the size of the ensemble, specifying the order in which the partitions in the ensemble should be aggregated. Defaults to using a random permutation (unlike the reference, which does not permute at all).} } } \item{\code{"HE"}}{a fixed-point algorithm for obtaining \emph{hard} least squares Euclidean consensus partitions (i.e., for minimizing \eqn{L} with Euclidean dissimilarity \eqn{d} and \eqn{p = 2} over all hard partitions with a given maximal number of classes.) Available control parameters are the same as for \code{"SE"}. This method can also be referred to as \code{"hard/euclidean"}. } \item{\code{"SM"}}{a fixed-point algorithm for obtaining \emph{soft} median Manhattan consensus partitions (i.e., for minimizing \eqn{L} with Manhattan dissimilarity \eqn{d} and \eqn{p = 1} over all soft partitions with a given maximal number of classes). Available control parameters are the same as for \code{"SE"}. This method can also be referred to as \code{"soft/manhattan"}. } \item{\code{"HM"}}{a fixed-point algorithm for obtaining \emph{hard} median Manhattan consensus partitions (i.e., for minimizing \eqn{L} with Manhattan dissimilarity \eqn{d} and \eqn{p = 1} over all hard partitions with a given maximal number of classes). Available control parameters are the same as for \code{"SE"}. This method can also be referred to as \code{"hard/manhattan"}. } \item{\code{"GV3"}}{a \acronym{SUMT} algorithm for the \dQuote{third model} in Gordon and Vichi (2001) for minimizing \eqn{L} with \eqn{d} being co-membership dissimilarity and \eqn{p = 2}. (See \code{\link{sumt}} for more information on the \acronym{SUMT} approach.) This optimization problem is equivalent to finding the membership matrix \eqn{m} for which the sum of the squared differences between \eqn{C(m) = m m'} and the weighted average co-membership matrix \eqn{\sum_b w_b C(m_b)} of the partitions is minimal. Available control parameters are \code{method}, \code{control}, \code{eps}, \code{q}, and \code{verbose}, which have the same roles as for \code{\link{sumt}}, and the following. \describe{ \item{\code{k}}{an integer giving the number of classes to be used for the least squares consensus partition. By default, the maximal number of classes in the ensemble is used.} \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{start}}{a matrix with number of rows equal to the size of the cluster ensemble, and \eqn{k} columns, to be used as a starting value, or a list of such matrices. By default, a membership based on a rank \eqn{k} approximation to the weighted average co-membership matrix is used.} } In the case of multiple runs, the first optimum found is returned. } \item{\code{"soft/symdiff"}}{a \acronym{SUMT} approach for minimizing \eqn{L = \sum w_b d(x_b, x)} over all soft partitions with a given maximal number of classes, where \eqn{d} is the Manhattan dissimilarity of the co-membership matrices (coinciding with symdiff partition dissimilarity in the case of hard partitions). Available control parameters are the same as for \code{"GV3"}. } \item{\code{"hard/symdiff"}}{an exact solver for minimizing \eqn{L = \sum w_b d(x_b, x)} over all hard partitions (possibly with a given maximal number of classes as specified by the control parameter \code{k}), where \eqn{d} is symdiff partition dissimilarity (so that soft partitions in the ensemble are replaced by their closest hard partitions), or equivalently, Rand distance or pair-bonds (Boorman-Arabie \eqn{D}) distance. The consensus solution is found via mixed linear or quadratic programming. } } By default, method \code{"SE"} is used for ensembles of partitions. If all elements of the ensemble are hierarchies, the following built-in methods for computing consensus hierarchies are available. \describe{ \item{\code{"euclidean"}}{an algorithm for minimizing \eqn{L(x) = \sum w_b d(x_b, x) ^ 2} over all dendrograms, where \eqn{d} is Euclidean dissimilarity. This is equivalent to finding the best least squares ultrametric approximation of the weighted average \eqn{d = \sum w_b u_b} of the ultrametrics \eqn{u_b} of the hierarchies \eqn{x_b}, which is attempted by calling \code{\link{ls_fit_ultrametric}} on \eqn{d} with appropriate control parameters. This method can also be referred to as \code{"cophenetic"}. } \item{\code{"manhattan"}}{a \acronym{SUMT} for minimizing \eqn{L = \sum w_b d(x_b, x)} over all dendrograms, where \eqn{d} is Manhattan dissimilarity. Available control parameters are the same as for \code{"euclidean"}. } \item{\code{"majority"}}{a hierarchy obtained from an extension of the majority consensus tree of Margush and McMorris (1981), which minimizes \eqn{L(x) = \sum w_b d(x_b, x)} over all dendrograms, where \eqn{d} is the symmetric difference dissimilarity. The unweighted \eqn{p}-majority tree is the \eqn{n}-tree (hierarchy in the strict sense) consisting of all subsets of objects contained in more than \eqn{100 p} percent of the \eqn{n}-trees \eqn{T_b} induced by the dendrograms, where \eqn{1/2 \le p < 1} and \eqn{p = 1/2} (default) corresponds to the standard majority tree. In the weighted case, it consists of all subsets \eqn{A} for which \eqn{\sum_{b: A \in T_b} w_b > W p}, where \eqn{W = \sum_b w_b}. We also allow for \eqn{p = 1}, which gives the \emph{strict consensus tree} consisting of all subsets contained in each of the \eqn{n}-trees. The majority dendrogram returned is a representation of the majority tree where all splits have height one. The fraction \eqn{p} can be specified via the control parameter \code{p}. } } By default, method \code{"euclidean"} is used for ensembles of hierarchies. If a user-defined consensus method is to be employed, it must be a function taking the cluster ensemble, the case weights, and a list of control parameters as its arguments, with formals named \code{x}, \code{weights}, and \code{control}, respectively. Most built-in methods use heuristics for solving hard optimization problems, and cannot be guaranteed to find a global minimum. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the methods. } \references{ E. Dimitriadou, A. Weingessel and K. Hornik (2002). A combination scheme for fuzzy clustering. \emph{International Journal of Pattern Recognition and Artificial Intelligence}, \bold{16}, 901--912. \cr \doi{10.1142/S0218001402002052}. A. D. Gordon and M. Vichi (2001). Fuzzy partition models for fitting a set of partitions. \emph{Psychometrika}, \bold{66}, 229--248. \doi{10.1007/BF02294837}. A. D. Gordon (1999). \emph{Classification} (2nd edition). Boca Raton, FL: Chapman & Hall/CRC. T. Margush and F. R. McMorris (1981). Consensus \eqn{n}-trees. \emph{Bulletin of Mathematical Biology}, \bold{43}, 239--244. \doi{10.1007/BF02459446}. } \seealso{ \code{\link{cl_medoid}}, \code{\link[ape]{consensus}} } \examples{ ## Consensus partition for the Rosenberg-Kim kinship terms partition ## data based on co-membership dissimilarities. data("Kinship82") m1 <- cl_consensus(Kinship82, method = "GV3", control = list(k = 3, verbose = TRUE)) ## (Note that one should really use several replicates of this.) ## Value for criterion function to be minimized: sum(cl_dissimilarity(Kinship82, m1, "comem") ^ 2) ## Compare to the consensus solution given in Gordon & Vichi (2001). data("Kinship82_Consensus") m2 <- Kinship82_Consensus[["JMF"]] sum(cl_dissimilarity(Kinship82, m2, "comem") ^ 2) ## Seems we get a better solution ... ## How dissimilar are these solutions? cl_dissimilarity(m1, m2, "comem") ## How "fuzzy" are they? cl_fuzziness(cl_ensemble(m1, m2)) ## Do the "nearest" hard partitions fully agree? cl_dissimilarity(as.cl_hard_partition(m1), as.cl_hard_partition(m2)) ## Consensus partition for the Gordon and Vichi (2001) macroeconomic ## partition data based on Euclidean dissimilarities. data("GVME") set.seed(1) ## First, using k = 2 classes. m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) ## (Note that one should really use several replicates of this.) ## Value of criterion function to be minimized: sum(cl_dissimilarity(GVME, m1, "GV1") ^ 2) ## Compare to the consensus solution given in Gordon & Vichi (2001). data("GVME_Consensus") m2 <- GVME_Consensus[["MF1/2"]] sum(cl_dissimilarity(GVME, m2, "GV1") ^ 2) ## Seems we get a slightly better solution ... ## But note that cl_dissimilarity(m1, m2, "GV1") ## and that the maximal deviation of the memberships is max(abs(cl_membership(m1) - cl_membership(m2))) ## so the differences seem to be due to rounding. ## Do the "nearest" hard partitions fully agree? table(cl_class_ids(m1), cl_class_ids(m2)) ## And now for k = 3 classes. m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 3, verbose = TRUE)) sum(cl_dissimilarity(GVME, m1, "GV1") ^ 2) ## Compare to the consensus solution given in Gordon & Vichi (2001). m2 <- GVME_Consensus[["MF1/3"]] sum(cl_dissimilarity(GVME, m2, "GV1") ^ 2) ## This time we look much better ... ## How dissimilar are these solutions? cl_dissimilarity(m1, m2, "GV1") ## Do the "nearest" hard partitions fully agree? table(cl_class_ids(m1), cl_class_ids(m2)) } \keyword{cluster} clue/man/cl_margin.Rd0000644000175100001440000000165011304023137014211 0ustar hornikusers\name{cl_margin} \alias{cl_margin} \title{Membership Margins} \description{ Compute the \emph{margin} of the memberships of a partition, i.e., the difference between the largest and second largest membership values of the respective objects. } \usage{ cl_margin(x) } \arguments{ \item{x}{an \R object representing a partition of objects.} } \details{ For hard partitions, the margins are always 1. For soft partitions, the margins may be taken as an indication of the \dQuote{sureness} of classifying an object to the class with maximum membership value. } \examples{ data("GVME") ## Look at the classes obtained for 1980: split(cl_object_names(GVME[["1980"]]), cl_class_ids(GVME[["1980"]])) ## Margins: x <- cl_margin(GVME[["1980"]]) ## Add names, and sort: names(x) <- cl_object_names(GVME[["1980"]]) sort(x) ## Note the "uncertainty" of assigning Egypt to the "intermediate" class ## of nations. } \keyword{cluster} clue/man/n_of_objects.Rd0000644000175100001440000000221212211412717014707 0ustar hornikusers\name{n_of_objects} \alias{n_of_objects} \title{Number of Objects in a Partition or Hierarchy} \description{Determine the number of objects from which a partition or hierarchy was obtained.} \usage{ n_of_objects(x) } \arguments{ \item{x}{an \R object representing a (hard of soft) partition or a hierarchy of objects, or dissimilarities between objects.} } \value{ An integer giving the number of objects. } \details{ This is a generic function. The methods provided in package \pkg{clue} handle the partitions and hierarchies obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{ape}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). There is also a method for object dissimilarities which inherit from class \code{"\link{dist}"}. } \seealso{ \code{\link{is.cl_partition}}, \code{\link{is.cl_hierarchy}} } \examples{ data("Cassini") pcl <- kmeans(Cassini$x, 3) n_of_objects(pcl) hcl <- hclust(dist(USArrests)) n_of_objects(hcl) } \keyword{cluster} clue/man/cl_object_names.Rd0000644000175100001440000000176712211412557015404 0ustar hornikusers\name{cl_object_names} \alias{cl_object_names} \title{Find Object Names} \description{ Find the names of the objects from which a taxonomy (partition or hierarchy) or proximity was obtained. } \usage{ cl_object_names(x) } \arguments{ \item{x}{an \R object representing a taxonomy or proximity.} } \value{ A character vector of length \code{\link{n_of_objects}(x)} in case the names of the objects could be determined, or \code{NULL}. } \details{ This is a generic function. The methods provided in package \pkg{clue} handle the partitions and hierarchies obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{ape}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself), in as much as possible. There is also a method for object dissimilarities which inherit from class \code{"\link{dist}"}. } \keyword{cluster} clue/man/Kinship82_Consensus.Rd0000644000175100001440000000307212734171653016114 0ustar hornikusers\name{Kinship82_Consensus} \alias{Kinship82_Consensus} \title{Gordon-Vichi Kinship82 Consensus Partition Data} \description{ The soft (\dQuote{fuzzy}) consensus partitions for the Rosenberg-Kim kinship terms partition data given in Gordon and Vichi (2001). } \usage{data("Kinship82_Consensus")} \format{ A named cluster ensemble of three soft partitions of the 15 kinship terms into three classes. } \details{ The elements of the ensemble are named \code{"MF1"}, \code{"MF2"}, and \code{"JMF"}, and correspond to the consensus partitions obtained by applying models 1, 2, and 3 in Gordon and Vichi (2001) to the kinship terms partition data in Rosenberg (1982), which are available as data set \code{\link{Kinship82}}. } \source{ Table 6 in Gordon and Vichi (2001). } \references{ A. D. Gordon and M. Vichi (2001). Fuzzy partition models for fitting a set of partitions. \emph{Psychometrika}, \bold{66}, 229--248. \doi{10.1007/BF02294837}. S. Rosenberg (1982). The method of sorting in multivariate research with applications selected from cognitive psychology and person perception. In N. Hirschberg and L. G. Humphreys (eds.), \emph{Multivariate Applications in the Social Sciences}, 117--142. Hillsdale, NJ: Erlbaum. } \examples{ ## Load the consensus partitions. data("Kinship82_Consensus") ## Fuzziness using the Partition Coefficient. cl_fuzziness(Kinship82_Consensus) ## (Corresponds to 1 - F in the source.) ## Dissimilarities: cl_dissimilarity(Kinship82_Consensus) cl_dissimilarity(Kinship82_Consensus, method = "comem") } \keyword{datasets} clue/man/pclust.Rd0000644000175100001440000001551611430740706013606 0ustar hornikusers\name{pclust} \alias{pclust} \alias{pclust_family} \alias{pclust_object} \title{Prototype-Based Partitioning} \description{ Obtain prototype-based partitions of objects by minimizing the criterion \eqn{\sum w_b u_{bj}^m d(x_b, p_j)^e}, the sum of the case-weighted and membership-weighted \eqn{e}-th powers of the dissimilarities between the objects \eqn{x_b} and the prototypes \eqn{p_j}, for suitable dissimilarities \eqn{d} and exponents \eqn{e}. } \usage{ pclust(x, k, family, m = 1, weights = 1, control = list()) pclust_family(D, C, init = NULL, description = NULL, e = 1, .modify = NULL, .subset = NULL) pclust_object(prototypes, membership, cluster, family, m = 1, value, ..., classes = NULL, attributes = NULL) } \arguments{ \item{x}{the object to be partitioned.} \item{k}{an integer giving the number of classes to be used in the partition.} \item{family}{an object of class \code{"pclust_family"} as generated by \code{pclust_family}, containing the information about \eqn{d} and \eqn{e}.} \item{m}{a number not less than 1 controlling the softness of the partition (as the \dQuote{fuzzification parameter} of the fuzzy \eqn{c}-means algorithm). The default value of 1 corresponds to hard partitions obtained from a generalized \eqn{k}-means problem; values greater than one give partitions of increasing softness obtained from a generalized fuzzy \eqn{c}-means problem.} \item{weights}{a numeric vector of non-negative case weights. Recycled to the number of elements given by \code{x} if necessary.} \item{control}{a list of control parameters. See \bold{Details}.} \item{D}{a function for computing dissimilarities \eqn{d} between objects and prototypes.} \item{C}{a \sQuote{consensus} function with formals \code{x}, \code{weights} and \code{control} for computing a consensus prototype \eqn{p} minimizing \eqn{\sum_b w_b d(x_b, p) ^ e}.} \item{init}{a function with formals \code{x} and \code{k} initializing an object with \eqn{k} prototypes from the object \code{x} to be partitioned.} \item{description}{a character string describing the family.} \item{e}{a number giving the exponent \eqn{e} of the criterion.} \item{.modify}{a function with formals \code{x}, \code{i} and \code{value} for modifying a single prototype, or \code{NULL} (default).} \item{.subset}{a function with formals \code{x} and \code{i} for subsetting prototypes, or \code{NULL} (default).} \item{prototypes}{an object representing the prototypes of the partition.} \item{membership}{an object of class \code{"\link{cl_membership}"} with the membership values \eqn{u_{bj}}.} \item{cluster}{the class ids of the nearest hard partition.} \item{value}{the value of the criterion to be minimized.} \item{...}{further elements to be included in the generated pclust object.} \item{classes}{a character vector giving further classes to be given to the generated pclust object in addition to \code{"pclust"}, or \code{NULL} (default).} \item{attributes}{a list of attributes, or \code{NULL} (default).} } \value{ \code{pclust} returns the partition found as an object of class \code{"pclust"} (as obtained by calling \code{pclust_object}) which in addition to the \emph{default} components contains \code{call} (the matched call) and a \code{converged} attribute indicating convergence status (i.e., whether the maximal number of iterations was reached). \code{pclust_family} returns an object of class \code{"pclust_family"}, which is a list with components corresponding to the formals of \code{pclust_family}. \code{pclust_object} returns an object inheriting from class \code{"pclust"}, which is a list with components corresponding to the formals (up to and including \code{...}) of \code{pclust_object}, and additional classes and attributes specified by \code{classes} and \code{attributes}, respectively. } \details{ For \eqn{m = 1}, a generalization of the Lloyd-Forgy variant of the \eqn{k}-means algorithm is used, which iterates between reclassifying objects to their closest prototypes (according to the dissimilarities given by \code{D}), and computing new prototypes as the consensus for the classes (using \code{C}). For \eqn{m > 1}, a generalization of the fuzzy \eqn{c}-means recipe (e.g., Bezdek (1981)) is used, which alternates between computing optimal memberships for fixed prototypes, and computing new prototypes as the suitably weighted consensus clusterings for the classes. This procedure is repeated until convergence occurs, or the maximal number of iterations is reached. Currently, no local improvement heuristics are provided. It is possible to perform several runs of the procedure via control arguments \code{nruns} or \code{start} (the default is to perform a single run), in which case the first partition with the smallest value of the criterion is returned. The dissimilarity and consensus functions as well as the exponent \eqn{e} are specified via \code{family}. In principle, arbitrary representations of objects to be partitioned and prototypes (which do not necessarily have to be \dQuote{of the same kind}) can be employed. In addition to \code{D} and \code{C}, what is needed are means to obtain an initial collection of \eqn{k} prototypes (\code{init}), to modify a single prototype (\code{.modify}), and subset the prototypes (\code{.subset}). By default, list and (currently, only dense) matrix (with the usual convention that the rows correspond to the objects) are supported. Otherwise, the family has to provide the functions needed. Available control parameters are as follows. \describe{ \item{\code{maxiter}}{an integer giving the maximal number of iterations to be performed. Defaults to 100.} \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{reltol}}{the relative convergence tolerance. Defaults to \code{sqrt(.Machine$double.eps)}.} \item{\code{start}}{a list of prototype objects to be used as starting values.} \item{\code{verbose}}{a logical indicating whether to provide some output on minimization progress. Defaults to \code{getOption("verbose")}.} \item{\code{control}}{control parameters to be used in the consensus function.} } The fixed point approach employed is a heuristic which cannot be guaranteed to find the global minimum, in particular if \code{C} is not an exact minimizer. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. } \references{ J. C. Bezdek (1981). \emph{Pattern recognition with fuzzy objective function algorithms}. New York: Plenum. } \seealso{ \code{\link[stats]{kmeans}}, \code{\link[e1071]{cmeans}}. } clue/man/cl_ensemble.Rd0000644000175100001440000000462311547637750014556 0ustar hornikusers\name{cl_ensemble} \alias{cl_ensemble} \alias{as.cl_ensemble} \alias{is.cl_ensemble} \title{Cluster Ensembles} \description{Creation and manipulation of cluster ensembles.} \usage{ cl_ensemble(..., list = NULL) as.cl_ensemble(x) is.cl_ensemble(x) } \arguments{ \item{\dots}{R objects representing clusterings of or dissimilarities between the same objects.} \item{list}{a list of R objects as in \code{\dots}.} \item{x}{for \code{as.cl_ensemble}, an R object as in \code{\dots}; for \code{is.cl_ensemble}, an arbitrary R object.} } \details{ \code{cl_ensemble} creates \dQuote{cluster ensembles}, which are realized as lists of clusterings (or dissimilarities) with additional class information, always inheriting from \code{"cl_ensemble"}. All elements of the ensemble must have the same number of objects. If all elements are partitions, the ensemble has class \code{"cl_partition_ensemble"}; if all elements are dendrograms, it has class \code{"cl_dendrogram_ensemble"} and inherits from \code{"cl_hierarchy_ensemble"}; if all elements are hierarchies (but not always dendrograms), it has class \code{"cl_hierarchy_ensemble"}. Note that empty or \dQuote{mixed} ensembles cannot be categorized according to the kind of elements they contain, and hence only have class \code{"cl_ensemble"}. The list representation makes it possible to use \code{lapply} for computations on the individual clusterings in (i.e., the components of) a cluster ensemble. Available methods for cluster ensembles include those for subscripting, \code{c}, \code{rep}, and \code{print}. There is also a \code{plot} method for ensembles for which all elements can be plotted (currently, additive trees, dendrograms and ultrametrics). } \value{ \code{cl_ensemble} returns a list of the given clusterings or dissimilarities, with additional class information (see \bold{Details}). } \examples{ d <- dist(USArrests) hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hclust_results <- lapply(hclust_methods, function(m) hclust(d, m)) names(hclust_results) <- hclust_methods ## Now create an ensemble from the results. hens <- cl_ensemble(list = hclust_results) hens ## Subscripting. hens[1 : 3] ## Replication. rep(hens, 3) ## Plotting. plot(hens, main = names(hens)) ## And continue to analyze the ensemble, e.g. round(cl_dissimilarity(hens, method = "gamma"), 4) } \keyword{cluster} clue/man/cl_pam.Rd0000644000175100001440000000515312734173110013520 0ustar hornikusers\name{cl_pam} \alias{cl_pam} \title{K-Medoids Partitions of Clusterings} \description{ Compute \eqn{k}-medoids partitions of clusterings. } \usage{ cl_pam(x, k, method = "euclidean", solver = c("pam", "kmedoids")) } \arguments{ \item{x}{an ensemble of partitions or hierarchies, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{k}{an integer giving the number of classes to be used in the partition.} \item{method}{a character string or a function, as for argument \code{method} of function \code{\link{cl_dissimilarity}}.} \item{solver}{a character string indicating the \eqn{k}-medoids solver to be employed. May be abbreviated. If \code{"pam"} (default), the Partitioning Around Medoids (Kaufman & Rousseeuw (1990), Chapter 2) heuristic \code{\link[cluster]{pam}} of package \pkg{cluster} is used. Otherwise, the exact algorithm of \code{\link{kmedoids}} is employed.} } \value{ An object of class \code{"cl_pam"} representing the obtained \dQuote{secondary} partition, which is a list with the following components. \item{cluster}{the class ids of the partition.} \item{medoid_ids}{the indices of the medoids.} \item{prototypes}{a cluster ensemble with the \eqn{k} prototypes (medoids).} \item{criterion}{the value of the criterion function of the partition.} \item{description}{a character string indicating the dissimilarity method employed.} } \details{ An optimal \eqn{k}-medoids partition of the given cluster ensemble is defined as a partition of the objects \eqn{x_i} (the elements of the ensemble) into \eqn{k} classes \eqn{C_1, \ldots, C_k} such that the criterion function \eqn{L = \sum_{l=1}^k \min_{j \in C_l} \sum_{i \in C_l} d(x_i, x_j)} is minimized. Such secondary partitions (e.g., Gordon & Vichi, 1998) are obtained by computing the dissimilarities \eqn{d} of the objects in the ensemble for the given dissimilarity method, and applying a dissimilarity-based \eqn{k}-medoids solver to \eqn{d}. } \references{ L. Kaufman and P. J. Rousseeuw (1990). \emph{Finding Groups in Data: An Introduction to Cluster Analysis}. Wiley, New York. A. D. Gordon and M. Vichi (1998). Partitions of partitions. \emph{Journal of Classification}, \bold{15}, 265--285. \doi{10.1007/s003579900034}. } \seealso{ \code{\link{cl_pclust}} for more general prototype-based partitions of clusterings. } \examples{ data("Kinship82") party <- cl_pam(Kinship82, 3, "symdiff") ## Compare results with tables 5 and 6 in Gordon & Vichi (1998). party lapply(cl_prototypes(party), cl_classes) table(cl_class_ids(party)) } \keyword{cluster} clue/man/CKME.Rd0000644000175100001440000000071011304023137012771 0ustar hornikusers\name{CKME} \alias{CKME} \title{Cassini Data Partitions Obtained by K-Means} \description{ A cluster ensemble of 50 \eqn{k}-means partitions of the Cassini data into three classes. } \usage{data("CKME")} \format{ A cluster ensemble of 50 (\eqn{k}-means) partitions. } \details{ The ensemble was generated via \preformatted{ require("clue") data("Cassini") set.seed(1234) CKME <- cl_boot(Cassini$x, 50, 3) } } \keyword{datasets} clue/man/cl_membership.Rd0000644000175100001440000000462312211412501015065 0ustar hornikusers\name{cl_membership} \alias{cl_membership} \alias{as.cl_membership} \title{Memberships of Partitions} \description{ Compute the memberships values for objects representing partitions. } \usage{ cl_membership(x, k = n_of_classes(x)) as.cl_membership(x) } \arguments{ \item{x}{an R object representing a partition of objects (for \code{cl_membership}) or raw memberships or class ids (for \code{as.cl_membership}).} \item{k}{an integer giving the number of columns (corresponding to class ids) to be used in the membership matrix. Must not be less, and default to, the number of classes in the partition.} } \value{ An object of class \code{"cl_membership"} with the matrix of membership values. } \details{ \code{cl_membership} is a generic function. The methods provided in package \pkg{clue} handle the partitions obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). \code{as.cl_membership} can be used for coercing \dQuote{raw} class ids (given as atomic vectors) or membership values (given as numeric matrices) to membership objects. } \seealso{ \code{\link{is.cl_partition}} } \examples{ ## Getting the memberships of a single soft partition. d <- dist(USArrests) hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hclust_results <- lapply(hclust_methods, function(m) hclust(d, m)) names(hclust_results) <- hclust_methods ## Now create an ensemble from the results. hens <- cl_ensemble(list = hclust_results) ## And add the results of agnes and diana. require("cluster") hens <- c(hens, list(agnes = agnes(d), diana = diana(d))) ## Create a dissimilarity object from this. d1 <- cl_dissimilarity(hens) ## And compute a soft partition. party <- fanny(d1, 2) round(cl_membership(party), 5) ## The "nearest" hard partition to this: as.cl_hard_partition(party) ## (which has the same class ids as cl_class_ids(party)). ## Extracting the memberships from the elements of an ensemble of ## partitions. pens <- cl_boot(USArrests, 30, 3) pens mems <- lapply(pens, cl_membership) ## And turning these raw memberships into an ensemble of partitions. pens <- cl_ensemble(list = lapply(mems, as.cl_partition)) pens pens[[length(pens)]] } \keyword{cluster} clue/man/ls_fit_ultrametric.Rd0000644000175100001440000002076712734173740016201 0ustar hornikusers\name{ls_fit_ultrametric} \encoding{UTF-8} \alias{ls_fit_ultrametric} \title{Least Squares Fit of Ultrametrics to Dissimilarities} \description{ Find the ultrametric with minimal square distance (Euclidean dissimilarity) to given dissimilarity objects. } \usage{ ls_fit_ultrametric(x, method = c("SUMT", "IP", "IR"), weights = 1, control = list()) } \arguments{ \item{x}{a dissimilarity object inheriting from or coercible to class \code{"\link{dist}"}, or an ensemble of such objects.} \item{method}{a character string indicating the fitting method to be employed. Must be one of \code{"SUMT"} (default), \code{"IP"}, or \code{"IR"}, or a unique abbreviation thereof.} \item{weights}{a numeric vector or matrix with non-negative weights for obtaining a weighted least squares fit. If a matrix, its numbers of rows and columns must be the same as the number of objects in \code{x}, and the lower diagonal part is used. Otherwise, it is recycled to the number of elements in \code{x}.} \item{control}{a list of control parameters. See \bold{Details}.} } \value{ An object of class \code{"\link{cl_ultrametric}"} containing the fitted ultrametric distances. } \details{ For a single dissimilarity object \code{x}, the problem to be solved is minimizing \deqn{L(u) = \sum_{i,j} w_{ij} (x_{ij} - u_{ij})^2} over all \eqn{u} satisfying the ultrametric constraints (i.e., for all \eqn{i, j, k}, \eqn{u_{ij} \le \max(u_{ik}, u_{jk})}). This problem is known to be NP hard (Krivanek and Moravek, 1986). For an ensemble of dissimilarity objects, the criterion function is \deqn{L(u) = \sum_b w_b \sum_{i,j} w_{ij} (x_{ij}(b) - u_{ij})^2,} where \eqn{w_b} is the weight given to element \eqn{x_b} of the ensemble and can be specified via control parameter \code{weights} (default: all ones). This problem reduces to the above basic problem with \eqn{x} as the \eqn{w_b}-weighted mean of the \eqn{x_b}. We provide three heuristics for solving the basic problem. Method \code{"SUMT"} implements the \acronym{SUMT} (Sequential Unconstrained Minimization Technique, Fiacco and McCormick, 1968) approach of de Soete (1986) which in turn simplifies the suggestions in Carroll and Pruzansky (1980). (See \code{\link{sumt}} for more information on the \acronym{SUMT} approach.) We then use a final single linkage hierarchical clustering step to ensure that the returned object exactly satisfies the ultrametric constraints. The starting value \eqn{u_0} is obtained by \dQuote{random shaking} of the given dissimilarity object (if not given). If there are missing values in \code{x}, i.e., the given dissimilarities are \emph{incomplete}, we follow a suggestion of de Soete (1984), imputing the missing values by the weighted mean of the non-missing ones, and setting the corresponding weights to zero. Available control parameters are \code{method}, \code{control}, \code{eps}, \code{q}, and \code{verbose}, which have the same roles as for \code{\link{sumt}}, and the following. \describe{ \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{start}}{a single dissimilarity, or a list of dissimilarities to be employed as starting values.} } The default optimization using conjugate gradients should work reasonably well for medium to large size problems. For \dQuote{small} ones, using \code{nlm} is usually faster. Note that the number of ultrametric constraints is of the order \eqn{n^3}, where \eqn{n} is the number of objects in the dissimilarity object, suggesting to use the \acronym{SUMT} approach in favor of \code{\link[stats]{constrOptim}}. If starting values for the \acronym{SUMT} are provided via \code{start}, the number of starting values gives the number of runs to be performed, and control option \code{nruns} is ignored. Otherwise, \code{nruns} starting values are obtained by random shaking of the dissimilarity to be fitted. In the case of multiple \acronym{SUMT} runs, the (first) best solution found is returned. Method \code{"IP"} implements the Iterative Projection approach of Hubert and Arabie (1995). This iteratively projects the current dissimilarities to the closed convex set given by the ultrametric constraints (3-point conditions) for a single index triple \eqn{(i, j, k)}, in fact replacing the two largest values among \eqn{d_{ij}, d_{ik}, d_{jk}} by their mean. The following control parameters can be provided via the \code{control} argument. \describe{ \item{\code{nruns}}{an integer giving the number of runs to be performed. Defaults to 1.} \item{\code{order}}{a permutation of the numbers from 1 to the number of objects in \code{x}, specifying the order in which the ultrametric constraints are considered, or a list of such permutations.} \item{\code{maxiter}}{an integer giving the maximal number of iterations to be employed.} \item{\code{tol}}{a double indicating the maximal convergence tolerance. The algorithm stops if the total absolute change in the dissimilarities in an iteration is less than \code{tol}.} \item{\code{verbose}}{a logical indicating whether to provide some output on minimization progress. Defaults to \code{getOption("verbose")}.} } If permutations are provided via \code{order}, the number of these gives the number of runs to be performed, and control option \code{nruns} is ignored. Otherwise, \code{nruns} randomly generated orders are tried. In the case of multiple runs, the (first) best solution found is returned. Non-identical weights and incomplete dissimilarities are currently not supported. Method \code{"IR"} implements the Iterative Reduction approach suggested by Roux (1988), see also Barthélémy and Guénoche (1991). This is similar to the Iterative Projection method, but modifies the dissimilarities between objects proportionally to the aggregated change incurred from the ultrametric projections. Available control parameters are identical to those of method \code{"IP"}. Non-identical weights and incomplete dissimilarities are currently not supported. It should be noted that all methods are heuristics which can not be guaranteed to find the global minimum. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. } \references{ J.-P. Barthélémy and A. Guénoche (1991). \emph{Trees and proximity representations}. Chichester: John Wiley & Sons. ISBN 0-471-92263-3. J. D. Carroll and S. Pruzansky (1980). Discrete and hybrid scaling models. In E. D. Lantermann and H. Feger (eds.), \emph{Similarity and Choice}. Bern (Switzerland): Huber. L. Hubert and P. Arabie (1995). Iterative projection strategies for the least squares fitting of tree structures to proximity data. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{48}, 281--317. \doi{10.1111/j.2044-8317.1995.tb01065.x}. M. Krivanek and J. Moravek (1986). NP-hard problems in hierarchical tree clustering. \emph{Acta Informatica}, \bold{23}, 311--323. \doi{10.1007/BF00289116}. M. Roux (1988). Techniques of approximation for building two tree structures. In C. Hayashi and E. Diday and M. Jambu and N. Ohsumi (Eds.), \emph{Recent Developments in Clustering and Data Analysis}, pages 151--170. New York: Academic Press. G. de Soete (1984). Ultrametric tree representations of incomplete dissimilarity data. \emph{Journal of Classification}, \bold{1}, 235--242. \doi{10.1007/BF01890124}. G. de Soete (1986). A least squares algorithm for fitting an ultrametric tree to a dissimilarity matrix. \emph{Pattern Recognition Letters}, \bold{2}, 133--137. \doi{10.1016/0167-8655(84)90036-9}. } \seealso{ \code{\link{cl_consensus}} for computing least squares (Euclidean) consensus hierarchies by least squares fitting of average ultrametric distances; \code{\link{l1_fit_ultrametric}}. } \examples{ ## Least squares fit of an ultrametric to the Miller-Nicely consonant ## phoneme confusion data. data("Phonemes") ## Note that the Phonemes data set has the consonant misclassification ## probabilities, i.e., the similarities between the phonemes. d <- as.dist(1 - Phonemes) u <- ls_fit_ultrametric(d, control = list(verbose = TRUE)) ## Cophenetic correlation: cor(d, u) ## Plot: plot(u) ## ("Basically" the same as Figure 1 in de Soete (1986).) } \keyword{cluster} \keyword{optimize} clue/man/cl_tabulate.Rd0000644000175100001440000000105311304023137014532 0ustar hornikusers\name{cl_tabulate} \alias{cl_tabulate} \title{Tabulate Vector Objects} \description{Tabulate the unique values in vector objects.} \usage{ cl_tabulate(x) } \arguments{ \item{x}{a vector.} } \value{ A data frame with components: \item{values}{the unique values.} \item{counts}{an integer vector with the number of times each of the unique values occurs in \code{x}.} } \examples{ data("Kinship82") tab <- cl_tabulate(Kinship82) ## The counts: tab$counts ## The most frequent partition: tab$values[[which.max(tab$counts)]] } \keyword{utilities} clue/man/n_of_classes.Rd0000644000175100001440000000347612211412701014721 0ustar hornikusers\name{n_of_classes} \alias{n_of_classes} \alias{cl_class_ids} \alias{as.cl_class_ids} \title{Classes in a Partition} \description{Determine the number of classes and the class ids in a partition of objects.} \usage{ n_of_classes(x) cl_class_ids(x) as.cl_class_ids(x) } \arguments{ \item{x}{an object representing a (hard or soft) partition (for \code{n_of_classes} and \code{cl_class_ids}), or raw class ids (for \code{as.cl_class_ids}).} } \value{ For \code{n_of_classes}, an integer giving the number of classes in the partition. For \code{cl_class_ids}, a vector of integers with the corresponding class ids. For soft partitions, the class ids returned are those of the \emph{nearest hard partition} obtained by taking the class ids of the (first) maximal membership values. } \details{ These function are generic functions. The methods provided in package \pkg{clue} handle the partitions obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). Note that the number of classes is taken as the number of distinct class ids actually used in the partition, and may differ from the number of columns in a membership matrix representing the partition. \code{as.cl_class_ids} can be used for coercing \dQuote{raw} class ids (given as atomic vectors) to class id objects. } \seealso{ \code{\link{is.cl_partition}} } \examples{ data("Cassini") party <- kmeans(Cassini$x, 3) n_of_classes(party) ## A simple confusion matrix: table(cl_class_ids(party), Cassini$classes) ## For an "oversize" membership matrix representation: n_of_classes(cl_membership(party, 6)) } \keyword{cluster} clue/man/cl_bag.Rd0000644000175100001440000000642014021342067013472 0ustar hornikusers\name{cl_bag} \alias{cl_bag} \title{Bagging for Clustering} \description{ Construct partitions of objects by running a base clustering algorithm on bootstrap samples from a given data set, and \dQuote{suitably} aggregating these primary partitions. } \usage{ cl_bag(x, B, k = NULL, algorithm = "kmeans", parameters = NULL, method = "DFBC1", control = NULL) } \arguments{ \item{x}{the data set of objects to be clustered, as appropriate for the base clustering algorithm.} \item{B}{an integer giving the number of bootstrap replicates.} \item{k}{\code{NULL} (default), or an integer giving the number of classes to be used for a partitioning base algorithm.} \item{algorithm}{a character string or function specifying the base clustering algorithm.} \item{parameters}{a named list of additional arguments to be passed to the base algorithm.} \item{method}{a character string indicating the bagging method to use. Currently, only method \code{"DFBC1"} is available, which implements algorithm \emph{BagClust1} in Dudoit & Fridlyand (2003).} \item{control}{a list of control parameters for the aggregation. Currently, not used.} } \value{ An R object representing a partition of the objects given in \code{x}. } \details{ Bagging for clustering is really a rather general conceptual framework than a specific algorithm. If the primary partitions generated in the bootstrap stage form a cluster ensemble (so that class memberships of the objects in \code{x} can be obtained), consensus methods for cluster ensembles (as implemented, e.g., in \code{\link{cl_consensus}} and \code{\link{cl_medoid}}) can be employed for the aggregation stage. In particular, (possibly new) bagging algorithms can easily be realized by directly running \code{\link{cl_consensus}} on the results of \code{\link{cl_boot}}. In BagClust1, aggregation proceeds by generating a reference partition by running the base clustering algorithm on the whole given data set, and averaging the ensemble memberships after optimally matching them to the reference partition (in fact, by minimizing Euclidean dissimilarity, see \code{\link{cl_dissimilarity}}). If the base clustering algorithm yields prototypes, aggregation can be based on clustering these. This is the idea underlying the \dQuote{Bagged Clustering} algorithm introduced in Leisch (1999) and implemented by function \code{\link[e1071]{bclust}} in package \pkg{e1071}. } \references{ S. Dudoit and J. Fridlyand (2003). Bagging to improve the accuracy of a clustering procedure. \emph{Bioinformatics}, \bold{19}/9, 1090--1099. \doi{10.1093/bioinformatics/btg038}. F. Leisch (1999). \emph{Bagged Clustering}. Working Paper 51, SFB \dQuote{Adaptive Information Systems and Modeling in Economics and Management Science}. \url{https://epub.wu.ac.at/1272/}. } \examples{ set.seed(1234) ## Run BagClust1 on the Cassini data. data("Cassini") party <- cl_bag(Cassini$x, 50, 3) plot(Cassini$x, col = cl_class_ids(party), xlab = "", ylab = "") ## Actually, using fuzzy c-means as a base learner works much better: if(require("e1071", quietly = TRUE)) { party <- cl_bag(Cassini$x, 20, 3, algorithm = "cmeans") plot(Cassini$x, col = cl_class_ids(party), xlab = "", ylab = "") } } \keyword{cluster} clue/man/cl_boot.Rd0000644000175100001440000000455211304023137013703 0ustar hornikusers\name{cl_boot} \alias{cl_boot} \title{Bootstrap Resampling of Clustering Algorithms} \description{ Generate bootstrap replicates of the results of applying a \dQuote{base} clustering algorithm to a given data set. } \usage{ cl_boot(x, B, k = NULL, algorithm = if (is.null(k)) "hclust" else "kmeans", parameters = list(), resample = FALSE) } \arguments{ \item{x}{the data set of objects to be clustered, as appropriate for the base clustering algorithm.} \item{B}{an integer giving the number of bootstrap replicates.} \item{k}{\code{NULL} (default), or an integer giving the number of classes to be used for a partitioning base algorithm.} \item{algorithm}{a character string or function specifying the base clustering algorithm.} \item{parameters}{a named list of additional arguments to be passed to the base algorithm.} \item{resample}{a logical indicating whether the data should be resampled in addition to \dQuote{sampling from the algorithm}. If resampling is used, the class memberships of the objects given in \code{x} are predicted from the results of running the base algorithm on bootstrap samples of \code{x}.} } \value{ A cluster ensemble of length \eqn{B}, with either (if resampling is not used, default) the results of running the base algorithm on the given data set, or (if resampling is used) the memberships for the given data predicted from the results of running the base algorithm on bootstrap samples of the data. } \details{ This is a rather simple-minded function with limited applicability, and mostly useful for studying the effect of (uncontrolled) random initializations of fixed-point partitioning algorithms such as \code{\link[stats]{kmeans}} or \code{\link[e1071]{cmeans}}, see the examples. To study the effect of varying control parameters or explicitly providing random starting values, the respective cluster ensemble has to be generated explicitly (most conveniently by using \code{\link{replicate}} to create a list \code{lst} of suitable instances of clusterings obtained by the base algorithm, and using \code{cl_ensemble(list = lst)} to create the ensemble). } \examples{ ## Study e.g. the effect of random kmeans() initializations. data("Cassini") pens <- cl_boot(Cassini$x, 15, 3) diss <- cl_dissimilarity(pens) summary(c(diss)) plot(hclust(diss)) } \keyword{cluster} clue/man/ls_fit_addtree.Rd0000644000175100001440000000676612734173577015271 0ustar hornikusers\name{ls_fit_addtree} \encoding{UTF-8} \alias{ls_fit_addtree} \alias{ls_fit_centroid} \title{Least Squares Fit of Additive Tree Distances to Dissimilarities} \description{ Find the additive tree distance or centroid distance minimizing least squares distance (Euclidean dissimilarity) to a given dissimilarity object. } \usage{ ls_fit_addtree(x, method = c("SUMT", "IP", "IR"), weights = 1, control = list()) ls_fit_centroid(x) } \arguments{ \item{x}{a dissimilarity object inheriting from class \code{"\link{dist}"}.} \item{method}{a character string indicating the fitting method to be employed. Must be one of \code{"SUMT"} (default), \code{"IP"}, or \code{"IR"}, or a unique abbreviation thereof.} \item{weights}{a numeric vector or matrix with non-negative weights for obtaining a weighted least squares fit. If a matrix, its numbers of rows and columns must be the same as the number of objects in \code{x}, and the lower diagonal part is used. Otherwise, it is recycled to the number of elements in \code{x}.} \item{control}{a list of control parameters. See \bold{Details}.} } \value{ An object of class \code{"cl_addtree"} containing the optimal additive tree distances. } \details{ See \code{\link{as.cl_addtree}} for details on additive tree distances and centroid distances. With \eqn{L(d) = \sum w_{ij} (x_{ij} - d_{ij})^2}, the problem to be solved by \code{ls_fit_addtree} is minimizing \eqn{L} over all additive tree distances \eqn{d}. This problem is known to be NP hard. We provide three heuristics for solving this problem. Method \code{"SUMT"} implements the \acronym{SUMT} (Sequential Unconstrained Minimization Technique, Fiacco and McCormick, 1968) approach of de Soete (1983). Incomplete dissimilarities are currently not supported. Methods \code{"IP"} and \code{"IR"} implement the Iterative Projection and Iterative Reduction approaches of Hubert and Arabie (1995) and Roux (1988), respectively. Non-identical weights and incomplete dissimilarities are currently not supported. See \code{\link{ls_fit_ultrametric}} for details on these methods and available control parameters. It should be noted that all methods are heuristics which can not be guaranteed to find the global minimum. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. \code{ls_fit_centroid} finds the centroid distance \eqn{d} minimizing \eqn{L(d)} (currently, only for the case of identical weights). This optimization problem has a closed-form solution. } \references{ A. V. Fiacco and G. P. McCormick (1968). \emph{Nonlinear programming: Sequential unconstrained minimization techniques}. New York: John Wiley & Sons. L. Hubert and P. Arabie (1995). Iterative projection strategies for the least squares fitting of tree structures to proximity data. \emph{British Journal of Mathematical and Statistical Psychology}, \bold{48}, 281--317. \doi{10.1111/j.2044-8317.1995.tb01065.x}. M. Roux (1988). Techniques of approximation for building two tree structures. In C. Hayashi and E. Diday and M. Jambu and N. Ohsumi (Eds.), \emph{Recent Developments in Clustering and Data Analysis}, pages 151--170. New York: Academic Press. G. de Soete (1983). A least squares algorithm for fitting additive trees to proximity data. \emph{Psychometrika}, \bold{48}, 621--626. \doi{10.1007/BF02293884}. } \keyword{cluster} \keyword{optimize} clue/man/cl_medoid.Rd0000644000175100001440000000331211726357356014217 0ustar hornikusers\name{cl_medoid} \alias{cl_medoid} \title{Medoid Partitions and Hierarchies} \description{ Compute the medoid of an ensemble of partitions or hierarchies, i.e., the element of the ensemble minimizing the sum of dissimilarities to all other elements. } \usage{ cl_medoid(x, method = "euclidean") } \arguments{ \item{x}{an ensemble of partitions or hierarchies, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{method}{a character string or a function, as for argument \code{method} of function \code{\link{cl_dissimilarity}}.} } \value{ The medoid partition or hierarchy. } \details{ Medoid clusterings are special cases of \dQuote{consensus} clusterings characterized as the solutions of an optimization problem. See Gordon (2001) for more information. The dissimilarities \code{d} for determining the medoid are obtained by calling \code{cl_dissimilarity} with arguments \code{x} and \code{method}. The medoid can then be found as the (first) row index for which the row sum of \code{as.matrix(d)} is minimal. Modulo possible differences in the case of ties, this gives the same results as (the medoid obtained by) \code{\link[cluster]{pam}} in package \pkg{cluster}. } \references{ A. D. Gordon (1999). \emph{Classification} (2nd edition). Boca Raton, FL: Chapman & Hall/CRC. } \seealso{ \code{\link{cl_consensus}} } \examples{ ## An ensemble of partitions. data("CKME") pens <- CKME[1 : 20] m1 <- cl_medoid(pens) diss <- cl_dissimilarity(pens) require("cluster") m2 <- pens[[pam(diss, 1)$medoids]] ## Agreement of medoid consensus partitions. cl_agreement(m1, m2) ## Or, more straightforwardly: table(cl_class_ids(m1), cl_class_ids(m2)) } \keyword{cluster} clue/man/partition.Rd0000644000175100001440000000525312734174303014304 0ustar hornikusers\name{partition} \alias{cl_partition} % class ... \alias{is.cl_partition} \alias{is.cl_hard_partition} \alias{is.cl_soft_partition} \alias{cl_hard_partition} % class ... \alias{as.cl_partition} \alias{as.cl_hard_partition} \title{Partitions} \description{ Determine whether an R object represents a partition of objects, or coerce to an R object representing such.} \usage{ is.cl_partition(x) is.cl_hard_partition(x) is.cl_soft_partition(x) as.cl_partition(x) as.cl_hard_partition(x) } \arguments{ \item{x}{an R object.} } \value{ For the testing functions, a logical indicating whether the given object represents a clustering of objects of the respective kind. For the coercion functions, a container object inheriting from \code{"cl_partition"}, with a suitable representation of the partition given by \code{x}. } \details{ \code{is.cl_partition} and \code{is.cl_hard_partition} are generic functions. The methods provided in package \pkg{clue} handle the partitions obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). \code{is.cl_soft_partition} gives true iff \code{is.cl_partition} is true and \code{is.cl_hard_partition} is false. \code{as.cl_partition} returns an object of class \code{"cl_partition"} \dQuote{containing} the given object \code{x} if this already represents a partition (i.e., \code{is.cl_partition(x)} is true), or the memberships obtained from \code{x} via \code{\link{as.cl_membership}}. \code{as.cl_hard_partition(x)} returns an object which has class \code{"cl_hard_partition"} and inherits from \code{"cl_partition"}, and contains \code{x} if it already represents a hard partition (i.e., provided that \code{is.cl_hard_partition(x)} is true), or the class ids obtained from \code{x}, using \code{x} if this is an atomic vector of raw class ids, or, if \code{x} represents a soft partition or is a raw matrix of membership values, using the class ids of the \emph{nearest hard partition}, defined by taking the class ids of the (first) maximal membership values. Conceptually, partitions and hard partitions are \emph{virtual} classes, allowing for a variety of representations. There are group methods for comparing partitions and computing their minimum, maximum, and range based on the meet and join operations, see \code{\link{cl_meet}}. } \examples{ data("Cassini") pcl <- kmeans(Cassini$x, 3) is.cl_partition(pcl) is.cl_hard_partition(pcl) is.cl_soft_partition(pcl) } \keyword{cluster} clue/man/Phonemes.Rd0000644000175100001440000000215714323456560014055 0ustar hornikusers\name{Phonemes} \alias{Phonemes} \title{Miller-Nicely Consonant Phoneme Confusion Data} \description{ Miller-Nicely data on the auditory confusion of 16 consonant phonemes. } \usage{data("Phonemes")} \format{ A symmetric matrix of the misclassification probabilities of 16 English consonant phonemes. } \details{ Miller and Nicely (1955) obtained the confusions by exposing female subjects to a series of syllables consisting of one of the 16 consonants followed by the vowel \samp{a} under 17 different experimental conditions. The data provided are obtained from aggregating the six so-called flat-noise conditions in which only the speech-to-noise ratio was varied into a single matrix of misclassification frequencies. } \source{ The data set is also contained in file \file{mapclus.data} in the shell archive \url{https://netlib.org/mds/mapclus.shar}. } \references{ G. A. Miller and P. E. Nicely (1955). An analysis of perceptual confusions among some English consonants. \emph{Journal of the Acoustical Society of America}, \bold{27}, 338--352. \doi{10.1121/1.1907526}. } \keyword{datasets} clue/man/cl_agreement.Rd0000644000175100001440000002370713761714616014734 0ustar hornikusers\name{cl_agreement} \alias{cl_agreement} \title{Agreement Between Partitions or Hierarchies} \description{Compute the agreement between (ensembles) of partitions or hierarchies. } \usage{ cl_agreement(x, y = NULL, method = "euclidean", \dots) } \arguments{ \item{x}{an ensemble of partitions or hierarchies and dissimilarities, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{y}{\code{NULL} (default), or as for \code{x}.} \item{method}{a character string specifying one of the built-in methods for computing agreement, or a function to be taken as a user-defined method. If a character string, its lower-cased version is matched against the lower-cased names of the available built-in methods using \code{\link{pmatch}}. See \bold{Details} for available built-in methods.} \item{\dots}{further arguments to be passed to methods.} } \value{ If \code{y} is \code{NULL}, an object of class \code{"cl_agreement"} containing the agreements between the all pairs of components of \code{x}. Otherwise, an object of class \code{"cl_cross_agreement"} with the agreements between the components of \code{x} and the components of \code{y}. } \details{ If \code{y} is given, its components must be of the same kind as those of \code{x} (i.e., components must either all be partitions, or all be hierarchies or dissimilarities). If all components are partitions, the following built-in methods for measuring agreement between two partitions with respective membership matrices \eqn{u} and \eqn{v} (brought to a common number of columns) are available: \describe{ \item{\code{"euclidean"}}{\eqn{1 - d / m}, where \eqn{d} is the Euclidean dissimilarity of the memberships, i.e., the square root of the minimal sum of the squared differences of \eqn{u} and all column permutations of \eqn{v}, and \eqn{m} is an upper bound for the maximal Euclidean dissimilarity. See Dimitriadou, Weingessel and Hornik (2002).} \item{\code{"manhattan"}}{\eqn{1 - d / m}, where \eqn{d} is the Manhattan dissimilarity of the memberships, i.e., the minimal sum of the absolute differences of \eqn{u} and all column permutations of \eqn{v}, and \eqn{m} is an upper bound for the maximal Manhattan dissimilarity.} \item{\code{"Rand"}}{the Rand index (the rate of distinct pairs of objects both in the same class or both in different classes in both partitions), see Rand (1971) or Gordon (1999), page 198. For soft partitions, (currently) the Rand index of the corresponding nearest hard partitions is used.} \item{\code{"cRand"}}{the Rand index corrected for agreement by chance, see Hubert and Arabie (1985) or Gordon (1999), page 198. Can only be used for hard partitions.} \item{\code{"NMI"}}{Normalized Mutual Information, see Strehl and Ghosh (2002). For soft partitions, (currently) the NMI of the corresponding nearest hard partitions is used.} \item{\code{"KP"}}{the Katz-Powell index, i.e., the product-moment correlation coefficient between the elements of the co-membership matrices \eqn{C(u) = u u'} and \eqn{C(v)}, respectively, see Katz and Powell (1953). For soft partitions, (currently) the Katz-Powell index of the corresponding nearest hard partitions is used. (Note that for hard partitions, the \eqn{(i,j)} entry of \eqn{C(u)} is one iff objects \eqn{i} and \eqn{j} are in the same class.)} \item{\code{"angle"}}{the maximal cosine of the angle between the elements of \eqn{u} and all column permutations of \eqn{v}.} \item{\code{"diag"}}{the maximal co-classification rate, i.e., the maximal rate of objects with the same class ids in both partitions after arbitrarily permuting the ids.} \item{\code{"FM"}}{the index of Fowlkes and Mallows (1983), i.e., the ratio \eqn{N_{xy} / \sqrt{N_x N_y}}{N_xy / sqrt(N_x N_y)} of the number \eqn{N_{xy}}{N_xy} of distinct pairs of objects in the same class in both partitions and the geometric mean of the numbers \eqn{N_x} and \eqn{N_y} of distinct pairs of objects in the same class in partition \eqn{x} and partition \eqn{y}, respectively. For soft partitions, (currently) the Fowlkes-Mallows index of the corresponding nearest hard partitions is used.} \item{\code{"Jaccard"}}{the Jaccard index, i.e., the ratio of the numbers of distinct pairs of objects in the same class in both partitions and in at least one partition, respectively. For soft partitions, (currently) the Jaccard index of the corresponding nearest hard partitions is used.} \item{\code{"purity"}}{the purity of the classes of \code{x} with respect to those of \code{y}, i.e., \eqn{\sum_j \max_i n_{ij} / n}, where \eqn{n_{ij}} is the joint frequency of objects in class \eqn{i} for \code{x} and in class \eqn{j} for \code{y}, and \eqn{n} is the total number of objects.} \item{\code{"PS"}}{Prediction Strength, see Tibshirani and Walter (2005): the minimum, over all classes \eqn{j} of \code{y}, of the maximal rate of objects in the same class for \code{x} and in class \eqn{j} for \code{y}.} } If all components are hierarchies, available built-in methods for measuring agreement between two hierarchies with respective ultrametrics \eqn{u} and \eqn{v} are as follows. \describe{ \item{\code{"euclidean"}}{\eqn{1 / (1 + d)}, where \eqn{d} is the Euclidean dissimilarity of the ultrametrics (i.e., the square root of the sum of the squared differences of \eqn{u} and \eqn{v}).} \item{\code{"manhattan"}}{\eqn{1 / (1 + d)}, where \eqn{d} is the Manhattan dissimilarity of the ultrametrics (i.e., the sum of the absolute differences of \eqn{u} and \eqn{v}).} \item{\code{"cophenetic"}}{The cophenetic correlation coefficient. (I.e., the product-moment correlation of the ultrametrics.)} \item{\code{"angle"}}{the cosine of the angle between the ultrametrics.} \item{\code{"gamma"}}{\eqn{1 - d}, where \eqn{d} is the rate of inversions between the associated ultrametrics (i.e., the rate of pairs \eqn{(i,j)} and \eqn{(k,l)} for which \eqn{u_{ij} < u_{kl}} and \eqn{v_{ij} > v_{kl}}). (This agreement measure is a linear transformation of Kruskal's \eqn{\gamma}{gamma}.)} } The measures based on ultrametrics also allow computing agreement with \dQuote{raw} dissimilarities on the underlying objects (R objects inheriting from class \code{"dist"}). If a user-defined agreement method is to be employed, it must be a function taking two clusterings as its arguments. Symmetric agreement objects of class \code{"cl_agreement"} are implemented as symmetric proximity objects with self-proximities identical to one, and inherit from class \code{"cl_proximity"}. They can be coerced to dense square matrices using \code{as.matrix}. It is possible to use 2-index matrix-style subscripting for such objects; unless this uses identical row and column indices, this results in a (non-symmetric agreement) object of class \code{"cl_cross_agreement"}. } \references{ E. Dimitriadou, A. Weingessel and K. Hornik (2002). A combination scheme for fuzzy clustering. \emph{International Journal of Pattern Recognition and Artificial Intelligence}, \bold{16}, 901--912. \cr \doi{10.1142/S0218001402002052}. E. B. Fowlkes and C. L. Mallows (1983). A method for comparing two hierarchical clusterings. \emph{Journal of the American Statistical Association}, \bold{78}, 553--569. \cr \doi{10.1080/01621459.1983.10478008}. A. D. Gordon (1999). \emph{Classification} (2nd edition). Boca Raton, FL: Chapman & Hall/CRC. L. Hubert and P. Arabie (1985). Comparing partitions. \emph{Journal of Classification}, \bold{2}, 193--218. \doi{10.1007/bf01908075}. W. M. Rand (1971). Objective criteria for the evaluation of clustering methods. \emph{Journal of the American Statistical Association}, \bold{66}, 846--850. \doi{10.2307/2284239}. L. Katz and J. H. Powell (1953). A proposed index of the conformity of one sociometric measurement to another. \emph{Psychometrika}, \bold{18}, 249--256. \doi{10.1007/BF02289063}. A. Strehl and J. Ghosh (2002). Cluster ensembles --- A knowledge reuse framework for combining multiple partitions. \emph{Journal of Machine Learning Research}, \bold{3}, 583--617. \cr \url{https://www.jmlr.org/papers/volume3/strehl02a/strehl02a.pdf}. R. Tibshirani and G. Walter (2005). Cluster validation by Prediction Strength. \emph{Journal of Computational and Graphical Statistics}, \bold{14}/3, 511--528. \doi{10.1198/106186005X59243}. } \seealso{ \code{\link{cl_dissimilarity}}; \code{\link[e1071]{classAgreement}} in package \pkg{e1071}. } \examples{ ## An ensemble of partitions. data("CKME") pens <- CKME[1 : 20] # for saving precious time ... summary(c(cl_agreement(pens))) summary(c(cl_agreement(pens, method = "Rand"))) summary(c(cl_agreement(pens, method = "diag"))) cl_agreement(pens[1:5], pens[6:7], method = "NMI") ## Equivalently, using subscripting. cl_agreement(pens, method = "NMI")[1:5, 6:7] ## An ensemble of hierarchies. d <- dist(USArrests) hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hclust_results <- lapply(hclust_methods, function(m) hclust(d, m)) names(hclust_results) <- hclust_methods hens <- cl_ensemble(list = hclust_results) summary(c(cl_agreement(hens))) ## Note that the Euclidean agreements are *very* small. ## This is because the ultrametrics differ substantially in height: u <- lapply(hens, cl_ultrametric) round(sapply(u, max), 3) ## Rescaling the ultrametrics to [0, 1] gives: u <- lapply(u, function(x) (x - min(x)) / (max(x) - min(x))) shens <- cl_ensemble(list = lapply(u, as.cl_dendrogram)) summary(c(cl_agreement(shens))) ## Au contraire ... summary(c(cl_agreement(hens, method = "cophenetic"))) cl_agreement(hens[1:3], hens[4:5], method = "gamma") } \keyword{cluster} clue/man/solve_LSAP.Rd0000644000175100001440000000331014241725155014234 0ustar hornikusers\name{solve_LSAP} \encoding{UTF-8} \alias{solve_LSAP} \title{Solve Linear Sum Assignment Problem} \description{ Solve the linear sum assignment problem using the Hungarian method. } \usage{ solve_LSAP(x, maximum = FALSE) } \arguments{ \item{x}{a matrix with nonnegative entries and at least as many columns as rows.} \item{maximum}{a logical indicating whether to minimize of maximize the sum of assigned costs.} } \details{ If \eqn{nr} and \eqn{nc} are the numbers of rows and columns of \code{x}, \code{solve_LSAP} finds an optimal \emph{assignment} of rows to columns, i.e., a one-to-one map \code{p} of the numbers from 1 to \eqn{nr} to the numbers from 1 to \eqn{nc} (a permutation of these numbers in case \code{x} is a square matrix) such that \eqn{\sum_{i=1}^{nr} x[i, p[i]]} is minimized or maximized. This assignment can be found using a linear program (and package \pkg{lpSolve} provides a function \code{lp.assign} for doing so), but typically more efficiently and provably in polynomial time \eqn{O(n^3)} using primal-dual methods such as the so-called Hungarian method (see the references). } \value{ An object of class \code{"solve_LSAP"} with the optimal assignment of rows to columns. } \references{ C. Papadimitriou and K. Steiglitz (1982), \emph{Combinatorial Optimization: Algorithms and Complexity}. Englewood Cliffs: Prentice Hall. } \author{ Walter Böhm \email{Walter.Boehm@wu.ac.at} kindly provided C code implementing the Hungarian method. } \examples{ x <- matrix(c(5, 1, 4, 3, 5, 2, 2, 4, 4), nrow = 3) solve_LSAP(x) solve_LSAP(x, maximum = TRUE) ## To get the optimal value (for now): y <- solve_LSAP(x) sum(x[cbind(seq_along(y), y)]) } \keyword{optimize} clue/man/cl_ultrametric.Rd0000644000175100001440000000440311304023137015266 0ustar hornikusers\name{cl_ultrametric} \alias{cl_ultrametric} \alias{as.cl_ultrametric} \title{Ultrametrics of Hierarchies} \description{ Compute the ultrametric distances for objects representing (total indexed) hierarchies. } \usage{ cl_ultrametric(x, size = NULL, labels = NULL) as.cl_ultrametric(x) } \arguments{ \item{x}{an R object representing a (total indexed) hierarchy of objects.} \item{size}{an integer giving the number of objects in the hierarchy.} \item{labels}{a character vector giving the names of the objects in the hierarchy.} } \value{ An object of class \code{"cl_ultrametric"} containing the ultrametric distances. } \details{ If \code{x} is not an ultrametric or a hierarchy with an ultrametric representation, \code{cl_ultrametric} uses \code{\link[stats]{cophenetic}} to obtain the ultrametric (also known as cophenetic) distances from the hierarchy, which in turn by default calls the S3 generic \code{\link[stats]{as.hclust}} on the hierarchy. Support for a class which represents hierarchies can thus be added by providing \code{as.hclust} methods for this class. In R 2.1.0 or better, \code{cophenetic} is an S3 generic as well, and one can also more directly provide methods for this if necessary. \code{as.cl_ultrametric} is a generic function which can be used for coercing \emph{raw} (non-classed) ultrametrics, represented as numeric vectors (of the lower-half entries) or numeric matrices, to ultrametric objects. Ultrametric objects are implemented as symmetric proximity objects with a dissimilarity interpretation so that self-proximities are zero, and inherit from classes \code{"\link{cl_dissimilarity}"} and \code{"cl_proximity"}. See section \bold{Details} in the documentation for \code{\link{cl_dissimilarity}} for implications. Ultrametric objects can also be coerced to classes \code{"\link[stats]{dendrogram}"} and \code{"\link[stats]{hclust}"}, and hence in particular use the \code{plot} methods for these classes. By default, plotting an ultrametric object uses the plot method for dendrograms. } \seealso{ \code{\link{is.cl_hierarchy}} } \examples{ hc <- hclust(dist(USArrests)) u <- cl_ultrametric(hc) ## Subscripting. u[1 : 5, 1 : 5] u[1 : 5, 6 : 7] ## Plotting. plot(u) } \keyword{cluster} clue/man/cl_predict.Rd0000644000175100001440000000411412211412617014367 0ustar hornikusers\name{cl_predict} \alias{cl_predict} \title{Predict Memberships} \description{ Predict class ids or memberships from R objects representing partitions. } \usage{ cl_predict(object, newdata = NULL, type = c("class_ids", "memberships"), ...) } \arguments{ \item{object}{an R object representing a partition of objects.} \item{newdata}{an optional data set giving the objects to make predictions for. This must be of the same \dQuote{kind} as the data set employed for obtaining the partition. If omitted, the original data are used.} \item{type}{a character string indicating whether class ids or memberships should be returned. May be abbreviated.} \item{\dots}{arguments to be passed to and from methods.} } \value{ Depending on \code{type}, an object of class \code{"cl_class_ids"} with the predicted class ids, or of class \code{"cl_membership"} with the matrix of predicted membership values. } \details{ Many algorithms resulting in partitions of a given set of objects can be taken to induce a partition of the underlying feature space for the measurements on the objects, so that class memberships for \dQuote{new} objects can be obtained from the induced partition. Examples include partitions based on assigning objects to their \dQuote{closest} prototypes, or providing mixture models for the distribution of objects in feature space. This is a generic function. The methods provided in package \pkg{clue} handle the partitions obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). } \examples{ ## Run kmeans on a random subset of the Cassini data, and predict the ## memberships for the "test" data set. data("Cassini") nr <- NROW(Cassini$x) ind <- sample(nr, 0.9 * nr, replace = FALSE) party <- kmeans(Cassini$x[ind, ], 3) table(cl_predict(party, Cassini$x[-ind, ]), Cassini$classes[-ind]) } \keyword{cluster} clue/man/Cassini.Rd0000644000175100001440000000237411304023137013653 0ustar hornikusers\name{Cassini} \alias{Cassini} \title{Cassini Data} \description{ A Cassini data set with 1000 points in 2-dimensional space which are drawn from the uniform distribution on 3 structures. The two outer structures are banana-shaped; the \dQuote{middle} structure in between them is a circle. } \usage{data("Cassini")} \format{ A classed list with components \describe{ \item{\code{x}}{a matrix with 1000 rows and 2 columns giving the coordinates of the points.} \item{\code{classes}}{a factor indicating which structure the respective points belong to.} } } \details{ Instances of Cassini data sets can be created using function \code{\link[mlbench]{mlbench.cassini}} in package \pkg{mlbench}. The data set at hand was obtained using \preformatted{ library("mlbench") set.seed(1234) Cassini <- mlbench.cassini(1000) } } \examples{ data("Cassini") op <- par(mfcol = c(1, 2)) ## Plot the data set: plot(Cassini$x, col = as.integer(Cassini$classes), xlab = "", ylab = "") ## Create a "random" k-means partition of the data: set.seed(1234) party <- kmeans(Cassini$x, 3) ## And plot that. plot(Cassini$x, col = cl_class_ids(party), xlab = "", ylab = "") ## (We can see the problem ...) par(op) } \keyword{datasets} clue/man/cl_prototypes.Rd0000644000175100001440000000265311304023137015170 0ustar hornikusers\name{cl_prototypes} \alias{cl_prototypes} \title{Partition Prototypes} \description{ Determine prototypes for the classes of an R object representing a partition. } \usage{ cl_prototypes(x) } \arguments{ \item{x}{an R object representing a partition of objects.} } \details{ Many partitioning methods are based on prototypes (\dQuote{centers}, \dQuote{centroids}, \dQuote{medoids}, \dots). In typical cases, these are points in the feature space for the measurements on the objects to be partitioned, such that one can quantify the distance between the objects and the prototypes, and, e.g., classify objects to their closest prototype. This is a generic function. The methods provided in package \pkg{clue} handle the partitions obtained from clustering functions in the base R distribution, as well as packages \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{kernlab}, and \pkg{mclust} (and of course, \pkg{clue} itself). } \examples{ ## Show how prototypes ("centers") vary across k-means runs on ## bootstrap samples from the Cassini data. data("Cassini") nr <- NROW(Cassini$x) out <- replicate(50, { kmeans(Cassini$x[sample(nr, replace = TRUE), ], 3) }, simplify = FALSE) ## Plot the data points in light gray, and the prototypes found. plot(Cassini$x, col = gray(0.8)) points(do.call("rbind", lapply(out, cl_prototypes)), pch = 19) } \keyword{cluster} clue/man/kmedoids.Rd0000644000175100001440000000414612734173215014073 0ustar hornikusers\name{kmedoids} \alias{kmedoids} \title{K-Medoids Clustering} \description{ Compute a \eqn{k}-medoids partition of a dissimilarity object. } \usage{ kmedoids(x, k) } \arguments{ \item{x}{a dissimilarity object inheriting from class \code{"\link{dist}"}, or a square matrix of pairwise object-to-object dissimilarity values.} \item{k}{an integer giving the number of classes to be used in the partition.} } \value{ An object of class \code{"kmedoids"} representing the obtained partition, which is a list with the following components. \item{cluster}{the class ids of the partition.} \item{medoid_ids}{the indices of the medoids.} \item{criterion}{the value of the criterion function of the partition.} } \details{ Let \eqn{d} denote the pairwise object-to-object dissimilarity matrix corresponding to \code{x}. A \eqn{k}-medoids partition of \code{x} is defined as a partition of the numbers from 1 to \eqn{n}, the number of objects in \code{x}, into \eqn{k} classes \eqn{C_1, \ldots, C_k} such that the criterion function \eqn{L = \sum_l \min_{j \in C_l} \sum_{i \in C_l} d_{ij}} is minimized. This is an NP-hard optimization problem. PAM (Partitioning Around Medoids, see Kaufman & Rousseeuw (1990), Chapter 2) is a very popular heuristic for obtaining optimal \eqn{k}-medoids partitions, and provided by \code{\link[cluster]{pam}} in package \pkg{cluster}. \code{kmedoids} is an exact algorithm based on a binary linear programming formulation of the optimization problem (e.g., Gordon & Vichi (1998), [P4']), using \code{\link[lpSolve]{lp}} from package \pkg{lpSolve} as solver. Depending on available hardware resources (the number of constraints of the program is of the order \eqn{n^2}), it may not be possible to obtain a solution. } \references{ L. Kaufman and P. J. Rousseeuw (1990). \emph{Finding Groups in Data: An Introduction to Cluster Analysis}. Wiley, New York. A. D. Gordon and M. Vichi (1998). Partitions of partitions. \emph{Journal of Classification}, \bold{15}, 265--285. \doi{10.1007/s003579900034}. } \keyword{cluster} \keyword{optimize} clue/man/cl_fuzziness.Rd0000644000175100001440000000500414021342416014774 0ustar hornikusers\name{cl_fuzziness} \alias{cl_fuzziness} \title{Partition Fuzziness} \description{ Compute the fuzziness of partitions. } \usage{ cl_fuzziness(x, method = NULL, normalize = TRUE) } \arguments{ \item{x}{a cluster ensemble of partitions, or an R object coercible to such.} \item{method}{a character string indicating the fuzziness measure to be employed, or \code{NULL} (default), or a function to be taken as a user-defined method. Currently available built-in methods are \code{"PC"} (Partition Coefficient) and \code{"PE"} (Partition Entropy), with the default corresponding to the first one. If \code{method} is a character string, its lower-cased version is matched against the lower-cased names of the available built-in methods using \code{\link{pmatch}}.} \item{normalize}{a logical indicating whether the fuzziness measure should be normalized in a way that hard partitions have value 0, and \dQuote{completely fuzzy} partitions (where for all objects, all classes get the same membership) have value 1.} } \details{ If \eqn{m} contains the membership values of a partition, the (unnormalized) Partition Coefficient and Partition Entropy are given by \eqn{\sum_{n,i} m_{n,i}^2} and \eqn{\sum_{n,i} H(m_{n,i})}, respectively, where \eqn{H(u) = u \log u - (1-u) \log(1-u)}{u log(u) - (1-u) log(1-u)}. Note that the normalization used here is different from the normalizations typically found in the literature. If a user-defined fuzziness method is to be employed, is must be a function taking a matrix of membership values and a logical to indicate whether normalization is to be performed as its arguments (in that order; argument names are not used). } \value{ An object of class \code{"cl_fuzziness"} giving the fuzziness values. } \references{ J. C. Bezdek (1981). \emph{Pattern Recognition with Fuzzy Objective Function Algorithms}. New York: Plenum. } \seealso{ Function \code{\link[e1071]{fclustIndex}} in package \pkg{e1071}, which also computes several other \dQuote{fuzzy cluster indexes} (typically based on more information than just the membership values). } \examples{ if(require("e1071", quietly = TRUE)) { ## Use an on-line version of fuzzy c-means from package e1071 if ## available. data("Cassini") pens <- cl_boot(Cassini$x, B = 15, k = 3, algorithm = "cmeans", parameters = list(method = "ufcl")) pens summary(cl_fuzziness(pens, "PC")) summary(cl_fuzziness(pens, "PE")) } } \keyword{cluster} clue/man/fit_ultrametric_target.Rd0000644000175100001440000000621411304023137017022 0ustar hornikusers\name{fit_ultrametric_target} \alias{ls_fit_ultrametric_target} \alias{l1_fit_ultrametric_target} \title{Fit Dissimilarities to a Hierarchy} \description{ Find the ultrametric from a target equivalence class of hierarchies which minimizes weighted Euclidean or Manhattan dissimilarity to a given dissimilarity object. } \usage{ ls_fit_ultrametric_target(x, y, weights = 1) l1_fit_ultrametric_target(x, y, weights = 1) } \arguments{ \item{x}{a dissimilarity object inheriting from class \code{"\link{dist}"}.} \item{y}{a target hierarchy.} \item{weights}{a numeric vector or matrix with non-negative weights for obtaining a weighted fit. If a matrix, its numbers of rows and columns must be the same as the number of objects in \code{x}. Otherwise, it is recycled to the number of elements in \code{x}.} } \value{ An object of class \code{"\link{cl_ultrametric}"} containing the optimal ultrametric distances. } \details{ The target equivalence class consists of all dendrograms for which the corresponding \eqn{n}-trees are the same as the one corresponding to \code{y}. I.e., all splits are the same as for \code{y}, and optimization is over the height of the splits. The criterion function to be optimized over all ultrametrics from the equivalence class is \eqn{\sum w_{ij} |x_{ij} - u_{ij}|^p}, where \eqn{p = 2} in the Euclidean and \eqn{p = 1} in the Manhattan case, respectively. The optimum can be computed as follows. Suppose split \eqn{s} joins object classes \eqn{A} and \eqn{B}. As the ultrametric dissimilarities of all objects in \eqn{A} to all objects in \eqn{B} must be the same value, say, \eqn{u_{A,B} = u_s}, the contribution from the split to the criterion function is of the form \eqn{f_s(u_s) = \sum_{i \in A, j \in B} w_{ij} |x_{ij} - u_s|^p}. We need to minimize \eqn{\sum_s f_s(u_s)} under the constraint that the \eqn{u_s} form a non-decreasing sequence, which is accomplished by using the Pool Adjacent Violator Algorithm (\acronym{PAVA}) using the weighted mean (\eqn{p = 2}) or weighted median (\eqn{p = 1}) for solving the blockwise optimization problems. } \seealso{ \code{\link{ls_fit_ultrametric}} for finding the ultrametric minimizing Euclidean dissimilarity (without fixing the splits). } \examples{ data("Phonemes") ## Note that the Phonemes data set has the consonant misclassification ## probabilities, i.e., the similarities between the phonemes. d <- as.dist(1 - Phonemes) ## Find the maximal dominated and miminal dominating ultrametrics by ## hclust() with single and complete linkage: y1 <- hclust(d, "single") y2 <- hclust(d, "complete") ## Note that these are quite different: cl_dissimilarity(y1, y2, "gamma") ## Now find the L2 optimal members of the respective dendrogram ## equivalence classes. u1 <- ls_fit_ultrametric_target(d, y1) u2 <- ls_fit_ultrametric_target(d, y2) ## Compute the L2 optimal ultrametric approximation to d. u <- ls_fit_ultrametric(d) ## And compare ... cl_dissimilarity(cl_ensemble(Opt = u, Single = u1, Complete = u2), d) ## The solution obtained via complete linkage is quite close: cl_agreement(u2, u, "cophenetic") } \keyword{cluster} \keyword{optimize} clue/man/GVME_Consensus.Rd0000644000175100001440000000343512734174635015101 0ustar hornikusers\name{GVME_Consensus} \alias{GVME_Consensus} \title{Gordon-Vichi Macroeconomic Consensus Partition Data} \description{ The soft (\dQuote{fuzzy}) consensus partitions for the macroeconomic partition data given in Gordon and Vichi (2001). } \usage{data("GVME_Consensus")} \format{ A named cluster ensemble of eight soft partitions of 21 countries terms into two or three classes. } \details{ The elements of the ensemble are consensus partitions for the macroeconomic partition data in Gordon and Vichi (2001), which are available as data set \code{\link{GVME}}. Element names are of the form \code{"\var{m}/\var{k}"}, where \var{m} indicates the consensus method employed (one of \samp{MF1}, \samp{MF2}, \samp{JMF}, and \samp{S&S}, corresponding to the application of models 1, 2, and 3 in Gordon and Vichi (2001) and the approach in Sato and Sato (1994), respectively), and \var{k} denotes the number classes (2 or 3). } \source{ Tables 4 and 5 in Gordon and Vichi (2001). } \references{ A. D. Gordon and M. Vichi (2001). Fuzzy partition models for fitting a set of partitions. \emph{Psychometrika}, \bold{66}, 229--248. \doi{10.1007/BF02294837}. M. Sato and Y. Sato (1994). On a multicriteria fuzzy clustering method for 3-way data. \emph{International Journal of Uncertainty, Fuzziness and Knowledge-Based Systems}, \bold{2}, 127--142. \cr \doi{10.1142/S0218488594000122}. } \examples{ ## Load the consensus partitions. data("GVME_Consensus") ## Pick the partitions into 2 classes. GVME_Consensus_2 <- GVME_Consensus[1 : 4] ## Fuzziness using the Partition Coefficient. cl_fuzziness(GVME_Consensus_2) ## (Corresponds to 1 - F in the source.) ## Dissimilarities: cl_dissimilarity(GVME_Consensus_2) cl_dissimilarity(GVME_Consensus_2, method = "comem") } \keyword{datasets} clue/man/cl_dissimilarity.Rd0000644000175100001440000003665512734174403015652 0ustar hornikusers\name{cl_dissimilarity} \encoding{UTF-8} \alias{cl_dissimilarity} \title{Dissimilarity Between Partitions or Hierarchies} \description{Compute the dissimilarity between (ensembles) of partitions or hierarchies.} \usage{ cl_dissimilarity(x, y = NULL, method = "euclidean", \dots) } \arguments{ \item{x}{an ensemble of partitions or hierarchies and dissimilarities, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{y}{\code{NULL} (default), or as for \code{x}.} \item{method}{a character string specifying one of the built-in methods for computing dissimilarity, or a function to be taken as a user-defined method. If a character string, its lower-cased version is matched against the lower-cased names of the available built-in methods using \code{\link{pmatch}}. See \bold{Details} for available built-in methods.} \item{\dots}{further arguments to be passed to methods.} } \value{ If \code{y} is \code{NULL}, an object of class \code{"cl_dissimilarity"} containing the dissimilarities between all pairs of components of \code{x}. Otherwise, an object of class \code{"cl_cross_dissimilarity"} with the dissimilarities between the components of \code{x} and the components of \code{y}. } \details{ If \code{y} is given, its components must be of the same kind as those of \code{x} (i.e., components must either all be partitions, or all be hierarchies or dissimilarities). If all components are partitions, the following built-in methods for measuring dissimilarity between two partitions with respective membership matrices \eqn{u} and \eqn{v} (brought to a common number of columns) are available: \describe{ \item{\code{"euclidean"}}{the Euclidean dissimilarity of the memberships, i.e., the square root of the minimal sum of the squared differences of \eqn{u} and all column permutations of \eqn{v}. See Dimitriadou, Weingessel and Hornik (2002).} \item{\code{"manhattan"}}{the Manhattan dissimilarity of the memberships, i.e., the minimal sum of the absolute differences of \eqn{u} and all column permutations of \eqn{v}.} \item{\code{"comemberships"}}{the Euclidean dissimilarity of the elements of the co-membership matrices \eqn{C(u) = u u'} and \eqn{C(v)}, i.e., the square root of the sum of the squared differences of \eqn{C(u)} and \eqn{C(v)}.} \item{\code{"symdiff"}}{the cardinality of the symmetric set difference of the sets of co-classified pairs of distinct objects in the partitions. I.e., the number of distinct pairs of objects in the same class in exactly one of the partitions. (Alternatively, the cardinality of the symmetric set difference between the (binary) equivalence relations corresponding to the partitions.) For soft partitions, (currently) the symmetric set difference of the corresponding nearest hard partitions is used.} \item{\code{"Rand"}}{the Rand distance, i.e., the rate of distinct pairs of objects in the same class in exactly one of the partitions. (Related to the Rand index \eqn{a} via the linear transformation \eqn{d = (1 - a) / 2}.) For soft partitions, (currently) the Rand distance of the corresponding nearest hard partitions is used.} \item{\code{"GV1"}}{the square root of the dissimilarity \eqn{\Delta_1}{Delta_1} used for the first model in Gordon and Vichi (2001), i.e., the square root of the minimal sum of the squared differences of the \emph{matched} non-zero columns of \eqn{u} and \eqn{v}.} \item{\code{"BA/\var{d}"}}{distance measures for hard partitions discussed in Boorman and Arabie (1972), with \var{d} one of \samp{A}, \samp{C}, \samp{D}, or \samp{E}. For soft partitions, the distances of the corresponding nearest hard partitions are used. \code{"BA/A"} is the minimum number of single element moves (move from one class to another or a new one) needed to transform one partition into the other. Introduced in Rubin (1967). \code{"BA/C"} is the minimum number of lattice moves for transforming one partition into the other, where partitions are said to be connected by a lattice move if one is \emph{just} finer than the other (i.e., there is no other partition between them) in the partition lattice (see \code{\link{cl_meet}}). Equivalently, with \eqn{z} the join of \code{x} and \code{y} and \eqn{S} giving the number of classes, this can be written as \eqn{S(x) + S(y) - 2 S(z)}. Attributed to David Pavy. \code{"BA/D"} is the \dQuote{pair-bonds} distance, which can be defined as \eqn{S(x) + S(y) - 2 S(z)}, with \eqn{z} the meet of \code{x} and \code{y} and \eqn{S} the \emph{supervaluation} (i.e., non-decreasing with respect to the partial order on the partition lattice) function \eqn{\sum_i (n_i (n_i - 1)) / (n (n - 1))}, where the \eqn{n_i} are the numbers of objects in the respective classes of the partition (such that \eqn{n_i (n_i - 1) / 2} are the numbers of pair bonds in the classes), and \eqn{n} the total number of objects. \code{"BA/E"} is the normalized information distance, defined as \eqn{1 - I / H}, where \eqn{I} is the average mutual information between the partitions, and \eqn{H} is the average entropy of the meet \eqn{z} of the partitions. Introduced in Rajski (1961). (Boorman and Arabie also discuss a distance measure (\eqn{B}) based on the minimum number of set moves needed to transform one partition into the other, which, differently from the \eqn{A} and \eqn{C} distance measures is hard to compute (Day, 1981) and (currently) not provided.)} \item{\code{"VI"}}{Variation of Information, see Meila (2003). If \code{\dots} has an argument named \code{weights}, it is taken to specify case weights.} \item{\code{"Mallows"}}{the Mallows-type distance by Zhou, Li and Zha (2005), which is related to the Monge-Kantorovich mass transfer problem, and given as the \eqn{p}-th root of the minimal value of the transportation problem \eqn{\sum w_{jk} \sum_i |u_{ij} - v_{ik}| ^ p} with constraints \eqn{w_{jk} \ge 0}, \eqn{\sum_j w_{jk} = \alpha_j}, \eqn{\sum_k w_{jk} = \beta_k}, where \eqn{\sum_j \alpha_j = \sum_k \beta_k}. The parameters \eqn{p}, \eqn{\alpha} and \eqn{\beta} all default to one (in this case, the Mallows distance coincides with the Manhattan dissimilarity), and can be specified via additional arguments named \code{p}, \code{alpha}, and \code{beta}, respectively.} \item{\code{"CSSD"}}{the Cluster Similarity Sensitive Distance of Zhou, Li and Zha (2005), which is given as the minimal value of \eqn{\sum_{k,l} (1 - 2 w_{kl} / (\alpha_k + \beta_l)) L_{kl}}, where \eqn{L_{kl} = \sum_i u_{ik} v_{il} d(p_{x;k}, p_{y;l})} with \eqn{p_{x;k}} and \eqn{p_{y;l}} the prototype of the \eqn{k}-th class of \code{x} and the \eqn{l}-th class of \code{y}, respectively, \eqn{d} is the distance between these, and the \eqn{w_{kl}} as for Mallows distance. If prototypes are matrices, the Euclidean distance between these is used as default. Using the additional argument \code{L}, one can give a matrix of \eqn{L_{kl}} values, or the function \eqn{d}. Parameters \eqn{\alpha} and \eqn{\beta} all default to one, and can be specified via additional arguments named \code{alpha} and \code{beta}, respectively.} } For hard partitions, both Manhattan and squared Euclidean dissimilarity give twice the \emph{transfer distance} (Charon et al., 2005), which is the minimum number of objects that must be removed so that the implied partitions (restrictions to the remaining objects) are identical. This is also known as the \emph{\eqn{R}-metric} in Day (1981), i.e., the number of augmentations and removals of single objects needed to transform one partition into the other, and the \emph{partition-distance} in Gusfield (2002), and equals twice the number of single element moves distance of Boorman and Arabie. For hard partitions, the pair-bonds (Boorman-Arabie \eqn{D}) distance is identical to the Rand distance, and can also be written as the Manhattan distance between the co-membership matrices corresponding to the partitions, or equivalently, their symdiff distance, normalized by \eqn{n (n - 1)}. If all components are hierarchies, available built-in methods for measuring dissimilarity between two hierarchies with respective ultrametrics \eqn{u} and \eqn{v} are as follows. \describe{ \item{\code{"euclidean"}}{the Euclidean dissimilarity of the ultrametrics (i.e., the square root of the sum of the squared differences of \eqn{u} and \eqn{v}).} \item{\code{"manhattan"}}{the Manhattan dissimilarity of the ultrametrics (i.e., the sum of the absolute differences of \eqn{u} and \eqn{v}).} \item{\code{"cophenetic"}}{\eqn{1 - c^2}, where \eqn{c} is the cophenetic correlation coefficient (i.e., the product-moment correlation of the ultrametrics).} \item{\code{"gamma"}}{the rate of inversions between the ultrametrics (i.e., the rate of pairs \eqn{(i,j)} and \eqn{(k,l)} for which \eqn{u_{ij} < u_{kl}} and \eqn{v_{ij} > v_{kl}}).} \item{\code{"symdiff"}}{the cardinality of the symmetric set difference of the sets of classes (hierarchies in the strict sense) induced by the dendrograms. I.e., the number of sets of objects obtained by a split in exactly one of the hierarchies.} \item{\code{"Chebyshev"}}{the Chebyshev (maximal) dissimilarity of the ultrametrics (i.e., the maximum of the absolute differences of \eqn{u} and \eqn{v}).} \item{\code{"Lyapunov"}}{the logarithm of the product of the maximal and minimal ratios of the ultrametrics. This is also known as the \dQuote{Hilbert projective metric} on the cone represented by the ultrametrics (e.g., Jardine & Sibson (1971), page 107), and only defined for \emph{strict} ultrametrics (which are strictly positive for distinct objects).} \item{\code{"BO"}}{the \eqn{m_\delta} family of tree metrics by Boorman and Olivier (1973), which are of the form \eqn{m_\delta = \int_0^\infty \delta(p(h), q(h)) dh}, where \eqn{p(h)} and \eqn{q(h)} are the hard partitions obtaining by cutting the trees (dendrograms) at height \eqn{h}, and \eqn{\delta} is a suitably dissimilarity measure for partitions. In particular, when taking \eqn{\delta} as symdiff or Rand dissimilarity, \eqn{m_\delta} is the Manhattan dissimilarity of the hierarchies. If \code{\dots} has an argument named \code{delta} it is taken to specify the partition dissimilarity \eqn{\delta} to be employed.} \item{\code{"spectral"}}{the spectral norm (2-norm) of the differences of the ultrametrics, suggested in Mérigot, Durbec, and Gaertner (2010).} } The measures based on ultrametrics also allow computing dissimilarity with \dQuote{raw} dissimilarities on the underlying objects (R objects inheriting from class \code{"dist"}). If a user-defined dissimilarity method is to be employed, it must be a function taking two clusterings as its arguments. Symmetric dissimilarity objects of class \code{"cl_dissimilarity"} are implemented as symmetric proximity objects with self-proximities identical to zero, and inherit from class \code{"cl_proximity"}. They can be coerced to dense square matrices using \code{as.matrix}. It is possible to use 2-index matrix-style subscripting for such objects; unless this uses identical row and column indices, this results in a (non-symmetric dissimilarity) object of class \code{"cl_cross_dissimilarity"}. Symmetric dissimilarity objects also inherit from class \code{"\link{dist}"} (although they currently do not \dQuote{strictly} extend this class), thus making it possible to use them directly for clustering algorithms based on dissimilarity matrices of this class, see the examples. } \references{ S. A. Boorman and P. Arabie (1972). Structural measures and the method of sorting. In R. N. Shepard, A. K. Romney, & S. B. Nerlove (eds.), \emph{Multidimensional Scaling: Theory and Applications in the Behavioral Sciences, 1: Theory} (pages 225--249). New York: Seminar Press. S. A. Boorman and D. C. Olivier (1973). Metrics on spaces of finite trees. \emph{Journal of Mathematical Psychology}, \bold{10}, 26--59. \doi{10.1016/0022-2496(73)90003-5}. I. Charon, L. Denoeud, A. Guénoche and O. Hudry (2006). \emph{Maximum Transfer Distance Between Partitions}. \emph{Journal of Classification}, \bold{23}, 103--121. \doi{10.1007/s00357-006-0006-2}. W. E. H. Day (1981). The complexity of computing metric distances between partitions. \emph{Mathematical Social Sciences}, \bold{1}, 269--287. \doi{10.1016/0165-4896(81)90042-1}. E. Dimitriadou, A. Weingessel and K. Hornik (2002). A combination scheme for fuzzy clustering. \emph{International Journal of Pattern Recognition and Artificial Intelligence}, \bold{16}, 901--912. \cr \doi{10.1142/S0218001402002052}. A. D. Gordon and M. Vichi (2001). Fuzzy partition models for fitting a set of partitions. \emph{Psychometrika}, \bold{66}, 229--248. \doi{10.1007/BF02294837}. D. Gusfield (2002). Partition-distance: A problem and class of perfect graphs arising in clustering. \emph{Information Processing Letters}, \bold{82}, 159--164. \doi{10.1016/S0020-0190(01)00263-0}. N. Jardine and E. Sibson (1971). \emph{Mathematical Taxonomy}. London: Wiley. M. Meila (2003). Comparing clusterings by the variation of information. In B. Schölkopf and M. K. Warmuth (eds.), \emph{Learning Theory and Kernel Machines}, pages 173--187. Springer-Verlag: Lecture Notes in Computer Science 2777. B. Mérigot, J.-P. Durbec and J.-C. Gaertner (2010). On goodness-of-fit measure for dendrogram-based analyses. \emph{Ecology}, \bold{91}, 1850—-1859. \doi{10.1890/09-1387.1}. C. Rajski (1961). A metric space of discrete probability distributions, \emph{Information and Control}, \bold{4}, 371--377. \doi{10.1016/S0019-9958(61)80055-7}. J. Rubin (1967). Optimal classification into groups: An approach for solving the taxonomy problem. \emph{Journal of Theoretical Biology}, \bold{15}, 103--144. \doi{10.1016/0022-5193(67)90046-X}. D. Zhou, J. Li and H. Zha (2005). A new Mallows distance based metric for comparing clusterings. In \emph{Proceedings of the 22nd international Conference on Machine Learning} (Bonn, Germany, August 07--11, 2005), pages 1028--1035. ICML '05, volume 119. ACM Press, New York, NY. \doi{10.1145/1102351.1102481}. } \seealso{ \code{\link{cl_agreement}} } \examples{ ## An ensemble of partitions. data("CKME") pens <- CKME[1 : 30] diss <- cl_dissimilarity(pens) summary(c(diss)) cl_dissimilarity(pens[1:5], pens[6:7]) ## Equivalently, using subscripting. diss[1:5, 6:7] ## Can use the dissimilarities for "secondary" clustering ## (e.g. obtaining hierarchies of partitions): hc <- hclust(diss) plot(hc) ## Example from Boorman and Arabie (1972). P1 <- as.cl_partition(c(1, 2, 2, 2, 3, 3, 2, 2)) P2 <- as.cl_partition(c(1, 1, 2, 2, 3, 3, 4, 4)) cl_dissimilarity(P1, P2, "BA/A") cl_dissimilarity(P1, P2, "BA/C") ## Hierarchical clustering. d <- dist(USArrests) x <- hclust(d) cl_dissimilarity(x, d, "cophenetic") cl_dissimilarity(x, d, "gamma") } \keyword{cluster} clue/man/cl_pclust.Rd0000644000175100001440000001036512734173132014262 0ustar hornikusers\name{cl_pclust} \alias{cl_pclust} \title{Prototype-Based Partitions of Clusterings} \description{ Compute prototype-based partitions of a cluster ensemble by minimizing \eqn{\sum w_b u_{bj}^m d(x_b, p_j)^e}, the sum of the case-weighted and membership-weighted \eqn{e}-th powers of the dissimilarities between the elements \eqn{x_b} of the ensemble and the prototypes \eqn{p_j}, for suitable dissimilarities \eqn{d} and exponents \eqn{e}. } \usage{ cl_pclust(x, k, method = NULL, m = 1, weights = 1, control = list()) } \arguments{ \item{x}{an ensemble of partitions or hierarchies, or something coercible to that (see \code{\link{cl_ensemble}}).} \item{k}{an integer giving the number of classes to be used in the partition.} \item{method}{the consensus method to be employed, see \code{\link{cl_consensus}}.} \item{m}{a number not less than 1 controlling the softness of the partition (as the \dQuote{fuzzification parameter} of the fuzzy \eqn{c}-means algorithm). The default value of 1 corresponds to hard partitions obtained from a generalized \eqn{k}-means problem; values greater than one give partitions of increasing softness obtained from a generalized fuzzy \eqn{c}-means problem.} \item{weights}{a numeric vector of non-negative case weights. Recycled to the number of elements in the ensemble given by \code{x} if necessary.} \item{control}{a list of control parameters. See \bold{Details}.} } \value{ An object of class \code{"cl_partition"} representing the obtained \dQuote{secondary} partition by an object of class \code{"cl_pclust"}, which is a list containing at least the following components. \item{prototypes}{a cluster ensemble with the \eqn{k} prototypes.} \item{membership}{an object of class \code{"\link{cl_membership}"} with the membership values \eqn{u_{bj}}.} \item{cluster}{the class ids of the nearest hard partition.} \item{silhouette}{Silhouette information for the partition, see \code{\link[cluster]{silhouette}}.} \item{validity}{precomputed validity measures for the partition.} \item{m}{the softness control argument.} \item{call}{the matched call.} \item{d}{the dissimilarity function \eqn{d = d(x, p)} employed.} \item{e}{the exponent \eqn{e} employed.} } \details{ Partitioning is performed using \code{\link{pclust}} via a family constructed from \code{method}. The dissimilarities \eqn{d} and exponent \eqn{e} are implied by the consensus method employed, and inferred via a registration mechanism currently only made available to built-in consensus methods. The default methods compute Least Squares Euclidean consensus clusterings, i.e., use Euclidean dissimilarity \eqn{d} and \eqn{e = 2}. For \eqn{m = 1}, the partitioning procedure was introduced by Gaul and Schader (1988) for \dQuote{Clusterwise Aggregation of Relations} (with the same domains), containing equivalence relations, i.e., hard partitions, as a special case. Available control parameters are as for \code{\link{pclust}}. The fixed point approach employed is a heuristic which cannot be guaranteed to find the global minimum (as this is already true for the computation of consensus clusterings). Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. } \references{ J. C. Bezdek (1981). \emph{Pattern recognition with fuzzy objective function algorithms}. New York: Plenum. W. Gaul and M. Schader (1988). Clusterwise aggregation of relations. \emph{Applied Stochastic Models and Data Analysis}, \bold{4}:273--282. \doi{10.1002/asm.3150040406}. } \examples{ ## Use a precomputed ensemble of 50 k-means partitions of the ## Cassini data. data("CKME") CKME <- CKME[1 : 30] # for saving precious time ... diss <- cl_dissimilarity(CKME) hc <- hclust(diss) plot(hc) ## This suggests using a partition with three classes, which can be ## obtained using cutree(hc, 3). Could use cl_consensus() to compute ## prototypes as the least squares consensus clusterings of the classes, ## or alternatively: set.seed(123) x1 <- cl_pclust(CKME, 3, m = 1) x2 <- cl_pclust(CKME, 3, m = 2) ## Agreement of solutions. cl_dissimilarity(x1, x2) table(cl_class_ids(x1), cl_class_ids(x2)) } \keyword{cluster} clue/man/hierarchy.Rd0000644000175100001440000000735412211412651014244 0ustar hornikusers\name{hierarchy} \alias{cl_hierarchy} % class ... \alias{is.cl_hierarchy} \alias{as.cl_hierarchy} \alias{cl_dendrogram} % class ... \alias{is.cl_dendrogram} \alias{as.cl_dendrogram} \alias{plot.cl_dendrogram} \title{Hierarchies} \description{ Determine whether an R object represents a hierarchy of objects, or coerce to an R object representing such.} \usage{ is.cl_hierarchy(x) is.cl_dendrogram(x) as.cl_hierarchy(x) as.cl_dendrogram(x) } \arguments{ \item{x}{an R object.} } \value{ For the testing functions, a logical indicating whether the given object represents a clustering of objects of the respective kind. For the coercion functions, a container object inheriting from \code{"cl_hierarchy"}, with a suitable representation of the hierarchy given by \code{x}. } \details{ These functions are generic functions. The methods provided in package \pkg{clue} handle the partitions and hierarchies obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}, \pkg{ape}, \pkg{cba}, \pkg{cclust}, \pkg{cluster}, \pkg{e1071}, \pkg{flexclust}, \pkg{flexmix}, \pkg{kernlab}, \pkg{mclust}, \pkg{movMF} and \pkg{skmeans} (and of course, \pkg{clue} itself). The hierarchies considered by \pkg{clue} are \emph{\eqn{n}-trees} (hierarchies in the strict sense) and \emph{dendrograms} (also known as valued \eqn{n}-trees or total indexed hierarchies), which are represented by the virtual classes \code{"cl_hierarchy"} and \code{"cl_dendrogram"} (which inherits from the former), respectively. \eqn{n}-trees on a set \eqn{X} of objects correspond to collections \eqn{H} of subsets of \eqn{X}, usually called \emph{classes} of the hierarchy, which satisfy the following properties: \itemize{ \item \eqn{H} contains all singletons with objects of \eqn{X}, \eqn{X} itself, but not the empty set; \item The intersection of two sets \eqn{A} and \eqn{B} in \eqn{H} is either empty or one of the sets. } The classes of a hierarchy can be obtained by \code{\link{cl_classes}}. Dendrograms are \eqn{n}-trees where additionally a height \eqn{h} is associated with each of the classes, so that for two classes \eqn{A} and \eqn{B} with non-empty intersection we have \eqn{h(A) \le h(B)} iff \eqn{A} is a subset of \eqn{B}. For each pair of objects one can then define \eqn{u_{ij}} as the height of the smallest class containing both \eqn{i} and \eqn{j}: this results in a dissimilarity on \eqn{X} which satisfies the ultrametric (3-point) conditions \eqn{u_{ij} \le \max(u_{ik}, u_{jk})} for all triples \eqn{(i, j, k)} of objects. Conversely, an ultrametric dissimilarity induces a unique dendrogram. The ultrametric dissimilarities of a dendrogram can be obtained by \code{\link{cl_ultrametric}}. \code{as.cl_hierarchy} returns an object of class \code{"cl_hierarchy"} \dQuote{containing} the given object \code{x} if this already represents a hierarchy (i.e., \code{is.cl_hierarchy(x)} is true), or the ultrametric obtained from \code{x} via \code{\link{as.cl_ultrametric}}. \code{as.cl_dendrogram} returns an object which has class \code{"cl_dendrogram"} and inherits from \code{"cl_hierarchy"}, and contains \code{x} if it represents a dendrogram (i.e., \code{is.cl_dendrogram(x)} is true), or the ultrametric obtained from \code{x}. Conceptually, hierarchies and dendrograms are \emph{virtual} classes, allowing for a variety of representations. There are group methods for comparing dendrograms and computing their minimum, maximum, and range based on the meet and join operations, see \code{\link{cl_meet}}. There is also a \code{plot} method. } \examples{ hcl <- hclust(dist(USArrests)) is.cl_dendrogram(hcl) is.cl_hierarchy(hcl) } \keyword{cluster} clue/man/cl_classes.Rd0000644000175100001440000000126711304023137014375 0ustar hornikusers\name{cl_classes} \alias{cl_classes} \title{Cluster Classes} \description{ Extract the classes in a partition or hierarchy. } \usage{ cl_classes(x) } \arguments{ \item{x}{an R object representing a partition or hierarchy of objects.} } \value{ A list inheriting from \code{"cl_classes_of_objects"} of vectors indicating the classes. } \details{ For partitions, the classes are the equivalence classes (\dQuote{clusters}) of the partition; for soft partitions, the classes of the nearest hard partition are used. For hierarchies represented by trees, the classes are the sets of objects corresponding to (joined at or split by) the nodes of the tree. } \keyword{cluster} clue/DESCRIPTION0000644000175100001440000000151314503545505012734 0ustar hornikusersPackage: clue Version: 0.3-65 Encoding: UTF-8 Title: Cluster Ensembles Description: CLUster Ensembles. Authors@R: c(person("Kurt", "Hornik", role = c("aut", "cre"), email = "Kurt.Hornik@R-project.org", comment = c(ORCID = "0000-0003-4198-9911")), person("Walter", "Böhm", role = "ctb")) License: GPL-2 Depends: R (>= 3.2.0) Imports: stats, cluster, graphics, methods Suggests: e1071, lpSolve (>= 5.5.7), quadprog (>= 1.4-8), relations Enhances: RWeka, ape, cba, cclust, flexclust, flexmix, kernlab, mclust, movMF, modeltools NeedsCompilation: yes Packaged: 2023-09-23 11:02:49 UTC; hornik Author: Kurt Hornik [aut, cre] (), Walter Böhm [ctb] Maintainer: Kurt Hornik Repository: CRAN Date/Publication: 2023-09-23 11:25:57 UTC clue/build/0000755000175100001440000000000014503542730012322 5ustar hornikusersclue/build/vignette.rds0000644000175100001440000000031114503542730014654 0ustar hornikusersb```b`afd`b2 1# 'H)M +Gt -.I-Rp+NMI-ƪ % M b fa(DXT%bZ]?tWxVaaqIY0AAn0Ez0?¹Ht&${+%$Q/nSaclue/build/partial.rdb0000644000175100001440000000007514503542715014454 0ustar hornikusersb```b`afd`b1 H020piּb C"{7clue/src/0000755000175100001440000000000014503542731012013 5ustar hornikusersclue/src/clue.c0000644000175100001440000000135211304023137013076 0ustar hornikusers#include #include #include "clue.h" double **clue_vector_to_square_matrix(double *x, Sint n) { double **data, *val; Sint i, j; data = (double **) R_alloc(n, sizeof(double)); for(i = 0; i < n; i++) { data[i] = (double *) R_alloc(n, sizeof(double)); val = x + i; for(j = 0; j < n; j++, val += n) data[i][j] = *val; } return(data); } static int clue_sign(double x) { if(x == 0) return(0); return((x > 0) ? 1 : -1); } void clue_dissimilarity_count_inversions(double *x, double *y, Sint *n, double *count) { Sint i, j; for(i = 0; i < *n; i++) for(j = 0; j < *n; j++) if((clue_sign(x[i] - x[j]) * clue_sign(y[i] - y[j])) < 0) (*count)++; } clue/src/clue.h0000644000175100001440000000210114245105414013102 0ustar hornikusers#ifndef _CLUE_H #define _CLUE_H #include typedef int Sint; void solve_LSAP(double *c, Sint *n, Sint *p); double **clue_vector_to_square_matrix(double *x, Sint n); void clue_dissimilarity_count_inversions(double *x, double *y, Sint *n, double *count); void deviation_from_ultrametricity(double *x, int *n, double *v, int *max); void deviation_from_ultrametricity_gradient(double *x, int *n, double *out); void deviation_from_additivity(double *x, int *n, double *v, int *max); void deviation_from_additivity_gradient(double *x, int *n, double *out); void ls_fit_ultrametric_by_iterative_reduction(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose); void ls_fit_ultrametric_by_iterative_projection(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose); void ls_fit_addtree_by_iterative_reduction(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose); void ls_fit_addtree_by_iterative_projection(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose); #endif clue/src/init.c0000644000175100001440000000373613340544526013135 0ustar hornikusers#include #include #include #include "clue.h" static R_NativePrimitiveArgType solve_LSAP_t[3] = { REALSXP, INTSXP, INTSXP }; static R_NativePrimitiveArgType clue_dissimilarity_count_inversions_t[4] = { REALSXP, REALSXP, INTSXP, REALSXP }; static R_NativePrimitiveArgType deviation_from_ultrametricity_t[4] = { REALSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType deviation_from_ultrametricity_gradient_t[3] = { REALSXP, INTSXP, REALSXP }; static R_NativePrimitiveArgType deviation_from_additivity_t[4] = { REALSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType deviation_from_additivity_gradient_t[3] = { REALSXP, INTSXP, REALSXP }; static R_NativePrimitiveArgType ls_fit_ultrametric_by_iterative_reduction_t[7] = { REALSXP, INTSXP, INTSXP, INTSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType ls_fit_ultrametric_by_iterative_projection_t[7] = { REALSXP, INTSXP, INTSXP, INTSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType ls_fit_addtree_by_iterative_reduction_t[7] = { REALSXP, INTSXP, INTSXP, INTSXP, INTSXP, REALSXP, LGLSXP }; static R_NativePrimitiveArgType ls_fit_addtree_by_iterative_projection_t[7] = { REALSXP, INTSXP, INTSXP, INTSXP, INTSXP, REALSXP, LGLSXP }; #define CDEF(name) {#name, (DL_FUNC) &name, sizeof(name ## _t)/sizeof(name ## _t[0]), name ##_t} static const R_CMethodDef cMethods[] = { CDEF(solve_LSAP), CDEF(clue_dissimilarity_count_inversions), CDEF(deviation_from_ultrametricity), CDEF(deviation_from_ultrametricity_gradient), CDEF(deviation_from_additivity), CDEF(deviation_from_additivity_gradient), CDEF(ls_fit_ultrametric_by_iterative_reduction), CDEF(ls_fit_ultrametric_by_iterative_projection), CDEF(ls_fit_addtree_by_iterative_reduction), CDEF(ls_fit_addtree_by_iterative_projection), {NULL, NULL, 0} }; void R_init_clue(DllInfo *dll) { R_registerRoutines(dll, cMethods, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } clue/src/assignment.h0000644000175100001440000000334511623271704014340 0ustar hornikusers#include #include #include #include /* INT_MAX */ #include /* DBL_MAX */ #include #include /* constants used for improving readability of code */ #define COVERED 1 #define UNCOVERED 0 #define ASSIGNED 1 #define UNASSIGNED 0 #define TRUE 1 #define FALSE 0 #define MARKED 1 #define UNMARKED 0 #define REDUCE 1 #define NOREDUCE 0 typedef struct{ int n; /* order of problem */ double **C; /* cost matrix */ double **c; /* reduced cost matrix */ int *s; /* assignment */ int *f; /* column i is assigned to f[i] */ int na; /* number of assigned items; */ int runs; /* number of iterations */ double cost; /* minimum cost */ time_t rtime; /* time */ } AP; /* public interface */ /* constructors and destructor */ AP *ap_create_problem(double *t, int n); AP *ap_create_problem_from_matrix(double **t, int n); AP *ap_read_problem(char *file); void ap_free(AP *p); int ap_assignment(AP *p, int *res); int ap_costmatrix(AP *p, double **m); int ap_datamatrix(AP *p, double **m); int ap_iterations(AP *p); void ap_hungarian(AP *p); double ap_mincost(AP *p); void ap_print_solution(AP *p); void ap_show_data(AP *p); int ap_size(AP *p); int ap_time(AP *p); /* error reporting */ void ap_error(char *message); /* private functions */ void preprocess(AP *p); void preassign(AP *p); int cover(AP *p, int *ri, int *ci); void reduce(AP *p, int *ri, int *ci); clue/src/trees.c0000644000175100001440000002401211304023137013266 0ustar hornikusers#include #include #include "clue.h" static int iwork3[3]; static int iwork4[4]; static void isort3(int *i, int *j, int *k) { iwork3[0] = *i; iwork3[1] = *j; iwork3[2] = *k; R_isort(iwork3, 3); *i = iwork3[0]; *j = iwork3[1]; *k = iwork3[2]; } static void isort4(int *i, int *j, int *k, int *l) { iwork4[0] = *i; iwork4[1] = *j; iwork4[2] = *k; iwork4[3] = *l; R_isort(iwork4, 4); *i = iwork4[0]; *j = iwork4[1]; *k = iwork4[2]; *l = iwork4[3]; } void deviation_from_ultrametricity(double *x, int *n, double *v, int *max) { double **D, p, delta, A, B, C; int i, j, k; D = clue_vector_to_square_matrix(x, *n); p = 0; for(i = 0; i < *n - 2; i++) for(j = i + 1; j < *n - 1; j++) { A = D[i][j]; for(k = j + 1; k < *n; k++) { B = D[i][k]; C = D[j][k]; if((A <= B) && (A <= C)) delta = C - B; else if(B <= C) delta = A - C; else delta = B - A; if(*max) p = fmax2(p, fabs(delta)); else p += delta * delta; } } *v = p; } void deviation_from_ultrametricity_gradient(double *x, int *n, double *out) { double **D, **G, A, B, C, delta; int i, j, k; D = clue_vector_to_square_matrix(x, *n); G = clue_vector_to_square_matrix(out, *n); for(i = 0; i < *n - 2; i++) for(j = i + 1; j < *n - 1; j++) { A = D[i][j]; for(k = j + 1; k < *n; k++) { B = D[i][k]; C = D[j][k]; if((A <= B) && (A <= C)) { delta = 2 * (B - C); G[i][k] += delta; G[j][k] -= delta; } else if(B <= C) { delta = 2 * (C - A); G[j][k] += delta; G[i][j] -= delta; } else { delta = 2 * (A - B); G[i][j] += delta; G[i][k] -= delta; } } } for(i = 0; i < *n; i++) for(j = 0; j < *n; j++) *out++ = G[i][j]; } void deviation_from_additivity(double *x, int *n, double *v, int *max) { double **D, p, delta, A, B, C; int i, j, k, l; D = clue_vector_to_square_matrix(x, *n); p = 0; for(i = 0; i < *n - 3; i++) for(j = i + 1; j < *n - 2; j++) for(k = j + 1; k < *n - 1; k++) for(l = k + 1; l < *n; l++) { A = D[i][j] + D[k][l]; B = D[i][k] + D[j][l]; C = D[i][l] + D[j][k]; if((A <= B) && (A <= C)) delta = (C - B); else if(B <= C) delta = (A - C); else delta = (B - A); if(*max) p = fmax2(p, fabs(delta)); else p += delta * delta; } *v = p; } void deviation_from_additivity_gradient(double *x, int *n, double *out) { double **D, **G, A, B, C, delta; int i, j, k, l; D = clue_vector_to_square_matrix(x, *n); G = clue_vector_to_square_matrix(out, *n); for(i = 0; i < *n - 3; i++) for(j = i + 1; j < *n - 2; j++) for(k = j + 1; k < *n - 1; k++) for(l = k + 1; l < *n; l++) { A = D[i][j] + D[k][l]; B = D[i][k] + D[j][l]; C = D[i][l] + D[j][k]; if((A <= B) && (A <= C)) { delta = 2 * (B - C); G[i][l] -= delta; G[j][k] -= delta; G[i][k] += delta; G[j][l] += delta; } else if(B <= C) { delta = 2 * (C - A); G[i][l] += delta; G[j][k] += delta; G[i][j] -= delta; G[k][l] -= delta; } else { delta = 2 * (A - B); G[i][k] -= delta; G[j][l] -= delta; G[i][j] += delta; G[k][l] += delta; } } for(i = 0; i < *n; i++) for(j = 0; j < *n; j++) *out++ = G[i][j]; } void ls_fit_ultrametric_by_iterative_reduction(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose) { double A, B, C, **D, DQ, delta, tmp; int i, i1, j, j1, k, k1, N3; D = clue_vector_to_square_matrix(d, *n); /* And initialize the upper half of D ("work array") to 0. (Yes, this could be done more efficiently by just propagating the veclh dist representation.) */ for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) D[i][j] = 0; N3 = (*n - 2); for(*iter = 0; *iter < *maxiter; (*iter)++) { if(*verbose) Rprintf("Iteration: %d, ", *iter); for(i1 = 0; i1 < *n - 2; i1++) for(j1 = i1 + 1; j1 < *n - 1; j1++) for(k1 = j1 + 1; k1 < *n; k1++) { i = order[i1]; j = order[j1]; k = order[k1]; isort3(&i, &j, &k); A = D[j][i]; B = D[k][i]; C = D[k][j]; /* B & G have a divisor of 2 for case 1 and 4 for cases 2 and 3 ... clearly, we should use the same in all cases, but should it be 2 or 4? */ if((A <= B) && (A <= C)) { /* Case 1: 5080 */ DQ = (C - B) / 2; D[i][k] += DQ; D[j][k] -= DQ; } else if(B <= C) { /* Case 2: 5100 */ DQ = (C - A) / 2; D[i][j] += DQ; D[j][k] -= DQ; } else { /* Case 3: 5120 */ DQ = (B - A) / 2; D[i][j] += DQ; D[i][k] -= DQ; } } delta = 0; for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) { tmp = D[i][j] / N3; D[j][i] += tmp; D[i][j] = 0; delta += fabs(tmp); } if(*verbose) Rprintf("change: %f\n", delta); if(delta < *tol) break; } /* And now write results back. Could make this more efficient, of course ... */ for(j = 0; j < *n; j++) for(i = 0; i < *n; i++) *d++ = D[i][j]; } void ls_fit_ultrametric_by_iterative_projection(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose) { double A, B, C, **D, delta; int i, i1, j, j1, k, k1; D = clue_vector_to_square_matrix(d, *n); for(*iter = 0; *iter < *maxiter; (*iter)++) { if(*verbose) Rprintf("Iteration: %d, ", *iter); delta = 0; for(i1 = 0; i1 < *n - 2; i1++) for(j1 = i1 + 1; j1 < *n - 1; j1++) for(k1 = j1 + 1; k1 < *n; k1++) { i = order[i1]; j = order[j1]; k = order[k1]; isort3(&i, &j, &k); A = D[i][j]; B = D[i][k]; C = D[j][k]; if((A <= B) && (A <= C)) { D[i][k] = D[j][k] = (B + C) / 2; delta += fabs(B - C); } else if(B <= C) { D[i][j] = D[j][k] = (C + A) / 2; delta += fabs(C - A); } else { D[i][j] = D[i][k] = (A + B) / 2; delta += fabs(A - B); } } if(*verbose) Rprintf("change: %f\n", delta); if(delta < *tol) break; } for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) D[j][i] = D[i][j]; /* And now write results back. Could make this more efficient, of course ... */ for(j = 0; j < *n; j++) for(i = 0; i < *n; i++) *d++ = D[i][j]; } void ls_fit_addtree_by_iterative_reduction(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose) { /* Once we have ls_fit_ultrametric_by_iterative_reduction() we can always do this as well ... See page 67f in Barthelemy and Guenoche. */ double A, B, C, **D, DQ, delta, tmp, N3; int i, i1, j, j1, k, k1, l, l1; D = clue_vector_to_square_matrix(d, *n); /* And initialize the upper half of D ("work array") to 0. (Yes, this could be done more efficiently by just propagating the veclh dist representation.) */ for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) D[i][j] = 0; N3 = (*n - 2) * (*n - 3) / 2; for(*iter = 0; *iter < *maxiter; (*iter)++) { if(*verbose) Rprintf("Iteration: %d, ", *iter); for(i1 = 0; i1 < *n - 3; i1++) for(j1 = i1 + 1; j1 < *n - 2; j1++) for(k1 = j1 + 1; k1 < *n - 1; k1++) for(l1 = k1 + 1; l1 < *n; l1++) { i = order[i1]; j = order[j1]; k = order[k1]; l = order[l1]; isort4(&i, &j, &k, &l); A = D[j][i] + D[l][k]; B = D[k][i] + D[l][j]; C = D[l][i] + D[k][j]; if((A <= B) && (A <= C)) { /* Case 1: 5090 */ DQ = (C - B) / 4; D[i][l] -= DQ; D[j][k] -= DQ; D[i][k] += DQ; D[j][l] += DQ; } else if(B <= C) { /* Case 2: 5120 */ DQ = (A - C) / 4; D[i][l] += DQ; D[j][k] += DQ; D[i][j] -= DQ; D[k][l] -= DQ; } else { /* Case 3: 5150 */ DQ = (B - A) / 4; D[i][k] -= DQ; D[j][l] -= DQ; D[i][j] += DQ; D[k][l] += DQ; } } delta = 0; for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) { tmp = D[i][j] / N3; D[j][i] += tmp; D[i][j] = 0; delta += fabs(tmp); } if(*verbose) Rprintf("change: %f\n", delta); if(delta < *tol) break; } /* And now write results back. Could make this more efficient, of course ... */ for(j = 0; j < *n; j++) for(i = 0; i < *n; i++) *d++ = D[i][j]; } void ls_fit_addtree_by_iterative_projection(double *d, int *n, int *order, int *maxiter, int *iter, double *tol, int *verbose) { double A, B, C, **D, DQ, delta; int i, i1, j, j1, k, k1, l, l1; D = clue_vector_to_square_matrix(d, *n); for(*iter = 0; *iter < *maxiter; (*iter)++) { delta = 0; if(*verbose) Rprintf("Iteration: %d, ", *iter); for(i1 = 0; i1 < *n - 3; i1++) for(j1 = i1 + 1; j1 < *n - 2; j1++) for(k1 = j1 + 1; k1 < *n - 1; k1++) for(l1 = k1 + 1; l1 < *n; l1++) { i = order[i1]; j = order[j1]; k = order[k1]; l = order[l1]; isort4(&i, &j, &k, &l); A = D[i][j] + D[k][l]; B = D[i][k] + D[j][l]; C = D[i][l] + D[j][k]; if((A <= B) && (A <= C)) { DQ = (C - B) / 4; D[i][l] -= DQ; D[j][k] -= DQ; D[i][k] += DQ; D[j][l] += DQ; delta += fabs(C - B); } else if(B <= C) { DQ = (A - C) / 4; D[i][l] += DQ; D[j][k] += DQ; D[i][j] -= DQ; D[k][l] -= DQ; delta += fabs(A - C); } else { DQ = (B - A) / 4; D[i][k] -= DQ; D[j][l] -= DQ; D[i][j] += DQ; D[k][l] += DQ; delta += fabs(B - A); } } if(*verbose) Rprintf("change: %f\n", delta); if(delta < *tol) break; } for(i = 0; i < *n - 1; i++) for(j = i + 1; j < *n; j++) D[j][i] = D[i][j]; /* And now write results back. Could make this more efficient, of course ... */ for(j = 0; j < *n; j++) for(i = 0; i < *n; i++) *d++ = D[i][j]; } clue/src/assignment.c0000644000175100001440000002370411623271641014334 0ustar hornikusers#include /* error() */ #include "assignment.h" /* main routine */ void ap_hungarian(AP *p) { int n; /* size of problem */ int *ri; /* covered rows */ int *ci; /* covered columns */ time_t start, end; /* timer */ int i, j, ok; start = time(0); n = p->n; p->runs = 0; /* allocate memory */ p->s = calloc(1 + n, sizeof(int)); p->f = calloc(1 + n, sizeof(int)); ri = calloc(1 + n, sizeof(int)); ci = calloc(1 + n, sizeof(int)); if(ri == NULL || ci == NULL || p->s == NULL || p->f == NULL) error("ap_hungarian: could not allocate memory!"); preprocess(p); preassign(p); while(p->na < n){ if(REDUCE == cover(p, ri, ci)) reduce(p, ri, ci); ++p->runs; } end = time(0); p->rtime = end - start; /* check if assignment is a permutation of (1..n) */ for(i = 1; i <= n; i++){ ok = 0; for(j = 1; j <= n; j++) if(p->s[j] == i) ++ok; if(ok != 1) error("ap_hungarian: error in assigment, is not a permutation!"); } /* calculate cost of assignment */ p->cost = 0; for(i = 1; i <= n; i++) p->cost+= p->C[i][p->s[i]]; /* reset result back to base-0 indexing */ for(i = 1; i <= n; i++) p->s[i - 1] = p->s[i] - 1; /* free memory */ free(ri); free(ci); } /* abbreviated interface */ int ap_assignment(AP *p, int *res) { int i; if(p->s == NULL) ap_hungarian(p); for(i = 0; i < p->n; i++) res[i] = p->s[i]; return p->n; } /*******************************************************************/ /* constructors */ /* read data from file */ /*******************************************************************/ AP *ap_read_problem(char *file) { FILE *f; int i,j,c; int m,n; double x; double **t; int nrow,ncol; AP *p; f = fopen(file,"r"); if(f==NULL) return NULL; t = (double **)malloc(sizeof(double*)); m = 0; n = 0; nrow = 0; ncol = 0; while(EOF != (i = fscanf(f, "%lf", &x))){ if(i == 1){ if(n == 0){ t = (double **) realloc(t,(m + 1) * sizeof(double *)); t[m] = (double *) malloc(sizeof(double)); }else t[m] = (double *) realloc(t[m], (n + 1) * sizeof(double)); t[m][n++] = x; ncol = (ncol < n) ? n : ncol; c=fgetc(f); if(c == '\n'){ n = 0; ++m; nrow = (nrow < m) ? m : nrow; } } } fclose(f); /* prepare data */ if(nrow != ncol){ /* fprintf(stderr,"ap_read_problem: problem not quadratic\nrows =%d, cols = %d\n",nrow,ncol); */ warning("ap_read_problem: problem not quadratic\nrows = %d, cols = %d\n", nrow, ncol); return NULL; } p = (AP*) malloc(sizeof(AP)); p->n = ncol; p->C = (double **) malloc((1 + nrow)*sizeof(double *)); p->c = (double **) malloc((1 + nrow)*sizeof(double *)); if(p->C == NULL || p->c == NULL) return NULL; for(i = 1; i <= nrow; i++){ p->C[i] = (double *) calloc(ncol + 1, sizeof(double)); p->c[i] = (double *) calloc(ncol + 1, sizeof(double)); if(p->C[i] == NULL || p->c[i] == NULL) return NULL; } for(i = 1; i <= nrow; i++) for( j = 1; j <= ncol; j++){ p->C[i][j] = t[i-1][j-1]; p->c[i][j] = t[i-1][j-1]; } for(i = 0; i < nrow; i++) free(t[i]); free(t); p->cost = 0; p->s = NULL; p->f = NULL; return p; } AP *ap_create_problem_from_matrix(double **t, int n) { int i,j; AP *p; p = (AP*) malloc(sizeof(AP)); if(p == NULL) return NULL; p->n = n; p->C = (double **) malloc((n + 1) * sizeof(double *)); p->c = (double **) malloc((n + 1) * sizeof(double *)); if(p->C == NULL || p->c == NULL) return NULL; for(i = 1; i <= n; i++){ p->C[i] = (double *) calloc(n + 1, sizeof(double)); p->c[i] = (double *) calloc(n + 1, sizeof(double)); if(p->C[i] == NULL || p->c[i] == NULL) return NULL; } for(i = 1; i <= n; i++) for( j = 1; j <= n; j++){ p->C[i][j] = t[i-1][j-1]; p->c[i][j] = t[i-1][j-1]; } p->cost = 0; p->s = NULL; p->f = NULL; return p; } /* read data from vector */ AP *ap_create_problem(double *t, int n) { int i,j; AP *p; p = (AP*) malloc(sizeof(AP)); if(p == NULL) return NULL; p->n = n; p->C = (double **) malloc((n + 1) * sizeof(double *)); p->c = (double **) malloc((n + 1) * sizeof(double *)); if(p->C == NULL || p->c == NULL) return NULL; for(i = 1; i <= n; i++){ p->C[i] = (double *) calloc(n + 1, sizeof(double)); p->c[i] = (double *) calloc(n + 1, sizeof(double)); if(p->C[i] == NULL || p->c[i] == NULL) return NULL; } for(i = 1; i <= n; i++) for( j = 1; j <= n; j++){ p->C[i][j] = t[n*(j - 1) + i - 1]; p->c[i][j] = t[n*(j - 1) + i - 1]; } p->cost = 0; p->s = NULL; p->f = NULL; return p; } /* destructor */ void ap_free(AP *p) { int i; free(p->s); free(p->f); for(i = 1; i <= p->n; i++){ free(p->C[i]); free(p->c[i]); } free(p->C); free(p->c); free(p); } /* set + get functions */ /* void ap_show_data(AP *p) { int i, j; for(i = 1; i <= p->n; i++){ for(j = 1; j <= p->n; j++) printf("%6.2f ", p->c[i][j]); printf("\n"); } } */ double ap_mincost(AP *p) { if(p->s == NULL) ap_hungarian(p); return p->cost; } int ap_size(AP *p) { return p->n; } int ap_time(AP *p) { return (int) p->rtime; } int ap_iterations(AP *p) { return p->runs; } /* void ap_print_solution(AP *p) { int i; printf("%d itertations, %d secs.\n",p->runs, (int)p->rtime); printf("Min Cost: %10.4f\n",p->cost); for(i = 0; i < p->n; i++) printf("%4d",p->s[i]); printf("\n"); } */ int ap_costmatrix(AP *p, double **m) { int i,j; for(i = 0; i < p->n; i++) for(j = 0; j < p->n; j++) m[i][j] = p->C[i + 1][j + 1]; return p->n; } int ap_datamatrix(AP *p, double **m) { int i,j; for(i = 0; i < p->n; i++) for(j = 0; j < p->n; j++) m[i][j] = p->c[i + 1][j + 1]; return p->n; } /* error reporting */ /* void ap_error(char *message) { fprintf(stderr,"%s\n",message); exit(1); } */ /*************************************************************/ /* these functions are used internally */ /* by ap_hungarian */ /*************************************************************/ int cover(AP *p, int *ri, int *ci) { int *mr, i, r; int n; n = p->n; mr = calloc(1 + p->n, sizeof(int)); /* reset cover indices */ for(i = 1; i <= n; i++){ if(p->s[i] == UNASSIGNED){ ri[i] = UNCOVERED; mr[i] = MARKED; } else ri[i] = COVERED; ci[i] = UNCOVERED; } while(TRUE){ /* find marked row */ r = 0; for(i = 1; i <= n; i++) if(mr[i] == MARKED){ r = i; break; } if(r == 0) break; for(i = 1; i <= n; i++) if(p->c[r][i] == 0 && ci[i] == UNCOVERED){ if(p->f[i]){ ri[p->f[i]] = UNCOVERED; mr[p->f[i]] = MARKED; ci[i] = COVERED; }else{ if(p->s[r] == UNASSIGNED) ++p->na; p->f[p->s[r]] = 0; p->f[i] = r; p->s[r] = i; free(mr); return NOREDUCE; } } mr[r] = UNMARKED; } free(mr); return REDUCE; } void reduce(AP *p, int *ri, int *ci) { int i, j, n; double min; n = p->n; /* find minimum in uncovered c-matrix */ min = DBL_MAX; for(i = 1; i <= n; i++) for(j = 1; j <= n; j++) if(ri[i] == UNCOVERED && ci[j] == UNCOVERED){ if(p->c[i][j] < min) min = p->c[i][j]; } /* subtract min from each uncovered element and add it to each element */ /* which is covered twice */ for(i = 1; i <= n; i++) for(j = 1; j <= n; j++){ if(ri[i] == UNCOVERED && ci[j] == UNCOVERED) p->c[i][j]-= min; if(ri[i] == COVERED && ci[j] == COVERED) p->c[i][j]+= min; } } void preassign(AP *p) { int i, j, min, r, c, n, count; int *ri, *ci, *rz, *cz; n = p->n; p->na = 0; /* row and column markers */ ri = calloc(1 + n, sizeof(int)); ci = calloc(1 + n, sizeof(int)); /* row and column counts of zeroes */ rz = calloc(1 + n, sizeof(int)); cz = calloc(1 + n, sizeof(int)); for(i = 1; i <= n; i++){ count = 0; for(j = 1; j <= n; j++) if(p->c[i][j] == 0) ++count; rz[i] = count; } for(i = 1; i <= n; i++){ count = 0; for(j = 1; j <= n; j++) if(p->c[j][i] == 0) ++count; cz[i] = count; } while(TRUE){ /* find unassigned row with least number of zeroes > 0 */ min = INT_MAX; r = 0; for(i = 1; i <= n; i++) if(rz[i] > 0 && rz[i] < min && ri[i] == UNASSIGNED){ min = rz[i]; r = i; } /* check if we are done */ if(r == 0) break; /* find unassigned column in row r with least number of zeroes */ c = 0; min = INT_MAX; for(i = 1; i <= n; i++) if(p->c[r][i] == 0 && cz[i] < min && ci[i] == UNASSIGNED){ min = cz[i]; c = i; } if(c){ ++p->na; p->s[r] = c; p->f[c] = r; ri[r] = ASSIGNED; ci[c] = ASSIGNED; /* adjust zero counts */ cz[c] = 0; for(i = 1; i <= n; i++) if(p->c[i][c] == 0) --rz[i]; } } /* free memory */ free(ri); free(ci); free(rz); free(cz); } void preprocess(AP *p) { int i, j, n; double min; n = p->n; /* subtract column minima in each row */ for(i = 1; i <= n; i++){ min = p->c[i][1]; for(j = 2; j <= n; j++) if(p->c[i][j] < min) min = p->c[i][j]; for(j = 1; j <= n; j++) p->c[i][j]-= min; } /* subtract row minima in each column */ for(i = 1; i <= n; i++){ min = p->c[1][i]; for(j = 2; j <= n; j++) if(p->c[j][i] < min) min = p->c[j][i]; for(j = 1; j <= n; j++) p->c[j][i]-= min; } } clue/src/lsap.c0000644000175100001440000000033311304023137013103 0ustar hornikusers#include #include "assignment.h" #include "clue.h" void solve_LSAP(double *c, Sint *n, Sint *p) { AP *ap; ap = ap_create_problem(c, *n); ap_hungarian(ap); ap_assignment(ap, p); ap_free(ap); } clue/vignettes/0000755000175100001440000000000014503542730013233 5ustar hornikusersclue/vignettes/cluster.bib0000644000175100001440000012321614134256553015404 0ustar hornikusers@Book{cluster:Arabie+Carroll+Desarbo:1987, author = {Arabie, Phipps and Carroll, J. Douglas and DeSarbo, Wayne}, title = {Three-way Scaling and Clustering}, year = 1987, pages = 92, publisher = {Sage Publications Inc}, } @Book{cluster:Arabie+Hubert+DeSoete:1996, author = {Phipps Arabie and Lawrence J. Hubert and Geert de Soete}, title = {Clustering and Classification}, year = 1996, pages = 490, publisher = {World Scientific Publications}, } @Book{cluster:Barthelemy+Guenoche:1991, author = {Jean-Pierry Barth\'el\'emy and Alain Gu\'enoche}, title = {Trees and Proximity Representations}, publisher = {John Wiley \& Sons}, year = 1991, series = {Wiley-Interscience Series in Discrete Mathematics and Optimization}, address = {Chichester}, note = {{ISBN 0-471-92263-3}}, } @Article{cluster:Barthelemy+Leclerc+Monjardet:1986, author = {Jean-Pierre Barth\'el\'emy and Bruno Leclerc and Bernard Monjardet}, title = {On the Use of Ordered Sets in Problems of Comparison and Consensus of Classifications}, journal = {Journal of Classification}, year = 1986, volume = 3, number = 2, pages = {187--224}, doi = {10.1007/BF01894188}, } @Article{cluster:Barthelemy+Mcmorris:1986, author = {Jean-Pierre Barth\'el\'emy and F. R. McMorris}, title = {The Median Procedure for $n$-trees}, year = 1986, journal = {Journal of Classification}, volume = 3, pages = {329--334}, doi = {10.1007/BF01894194}, } @Article{cluster:Barthelemy+Monjardet:1981, author = {Jean-Pierre Barth\'el\'emy and Bernard Monjardet}, title = {The Median Procedure in Cluster Analysis and Social Choice Theory}, journal = {Mathematical Social Sciences}, year = 1981, volume = 1, pages = {235--267}, doi = {10.1016/0165-4896(81)90041-X}, } @TechReport{cluster:Bertsekas+Tseng:1994, author = {Dimitri P. Bertsekas and P. Tseng}, title = {{RELAX-IV}: A Faster Version of the {RELAX} Code for Solving Minimum Cost Flow Problems}, institution = {Massachusetts Institute of Technology}, year = 1994, number = {P-2276}, url = {https://dspace.mit.edu/handle/1721.1/3392}, } @Book{cluster:Bezdek:1981, author = {James C. Bezdek}, title = {Pattern Recognition with Fuzzy Objective Function Algorithms}, publisher = {Plenum}, address = {New York}, year = 1981, } @InCollection{cluster:Boorman+Arabie:1972, author = {Scott A. Boorman and Phipps Arabie}, title = {Structural Measures and the Method of Sorting}, booktitle = {Multidimensional Scaling: Theory and Applications in the Behavioral Sciences, 1: Theory}, pages = {225--249}, publisher = {Seminar Press}, year = 1972, editor = {Roger N. Shepard and A. Kimball Romney and Sara Beth Nerlove}, address = {New York}, } @Article{cluster:Boorman+Olivier:1973, author = {Scott A. Boorman and Donald C. Olivier}, title = {Metrics on Spaces of Finite Trees}, journal = {Journal of Mathematical Psychology}, year = 1973, volume = 10, number = 1, pages = {26--59}, doi = {10.1016/0022-2496(73)90003-5}, } @Article{cluster:Breiman:1996, author = {Leo Breiman}, title = {Bagging Predictors}, journal = {Machine Learning}, year = 1996, volume = 24, number = 2, pages = {123--140}, doi = {10.1023/A:1018054314350}, } @Manual{cluster:Buchta+Hahsler:2005, title = {cba: Clustering for Business Analytics}, author = {Christian Buchta and Michael Hahsler}, year = 2005, note = {R package version 0.1-6}, url = {https://CRAN.R-project.org/package=cba}, } @Article{cluster:Buttrey:2005, author = {Samuel E. Buttrey}, title = {Calling the \texttt{lp\_solve} Linear Program Software from {R}, {S-PLUS} and {Excel}}, journal = {Journal of Statistical Software}, year = 2005, volume = 14, number = 4, doi = {10.18637/jss.v014.i04}, } @article{cluster:Carpaneto+Toth:1980, author = {Giorgio Carpaneto and Paolo Toth}, title = {Algorithm 548: Solution of the Assignment Problem}, journal = {ACM Transactions on Mathematical Software}, volume = 6, number = 1, year = 1980, issn = {0098-3500}, pages = {104--111}, doi = {10.1145/355873.355883}, publisher = {ACM Press}, } @Article{cluster:Carroll+Clark+Desarbo:1984, author = {Carroll, J. Douglas and Clark, Linda A. and DeSarbo, Wayne S.}, title = {The Representation of Three-way Proximity Data by Single and Multiple Tree Structure Models}, year = 1984, journal = {Journal of Classification}, volume = 1, pages = {25--74}, keywords = {Clustering analysis; Alternating least squares; Discrete optimization}, doi = {10.1007/BF01890116}, } @InCollection{cluster:Carroll+Pruzansky:1980, author = {J. D. Carroll and S. Pruzansky}, title = {Discrete and Hybrid Scaling Models}, booktitle = {Similarity and Choice}, address = {Bern, Switzerland}, publisher = {Huber}, year = 1980, editor = {E. D. Lantermann and H. Feger}, } @Article{cluster:Carroll:1976, author = {Carroll, J. Douglas}, title = {Spatial, Non-spatial and Hybrid Models for Scaling}, year = 1976, journal = {Psychometrika}, volume = 41, pages = {439--464}, keywords = {Multidimensional scaling; Hierarchical tree structure; Clustering; Geometric model; Multivariate data}, doi = {10.1007/BF02296969}, } @TechReport{cluster:Charon+Denoeud+Guenoche:2005, author = {Ir{\`e}ne Charon and Lucile Denoeud and Alain Gu{\'e}noche and Olivier Hudry}, title = {Maximum Transfer Distance Between Partitions}, institution = {Ecole Nationale Sup{\'e}rieure des T{\'e}l{\'e}communications --- Paris}, year = 2005, number = {2005D003}, month = {May}, note = {ISSN 0751-1345 ENST D}, } @Article{cluster:Charon+Denoeud+Guenoche:2006, author = {Ir{\`e}ne Charon and Lucile Denoeud and Alain Gu{\'e}noche and Olivier Hudry}, title = {Maximum Transfer Distance Between Partitions}, journal = {Journal of Classification}, year = 2006, volume = 23, number = 1, pages = {103-121}, month = {June}, doi = {10.1007/s00357-006-0006-2}, } @Article{cluster:Day:1981, author = {William H. E. Day}, title = {The Complexity of Computing Metric Distances Between Partitions}, journal = {Mathematical Social Sciences}, year = 1981, volume = 1, pages = {269--287}, doi = {10.1016/0165-4896(81)90042-1}, } @Article{cluster:Day:1986, author = {William H. E. Day}, title = {Foreword: Comparison and Consensus of Classifications}, journal = {Journal of Classification}, year = 1986, volume = 3, pages = {183--185}, doi = {10.1007/BF01894187}, } @Article{cluster:Day:1987, author = {Day, William H. E.}, title = {Computational Complexity of Inferring Phylogenies from Dissimilarity Matrices}, year = 1987, journal = {Bulletin of Mathematical Biology}, volume = 49, pages = {461--467}, doi = {10.1007/BF02458863}, } @Article{cluster:DeSoete+Carroll+Desarbo:1987, author = {De Soete, Geert and Carroll, J. Douglas and DeSarbo, Wayne S.}, title = {Least Squares Algorithms for Constructing Constrained Ultrametric and Additive Tree Representations of Symmetric Proximity Data}, year = 1987, journal = {Journal of Classification}, volume = 4, pages = {155--173}, keywords = {Hierarchical clustering; Classification}, doi = {10.1007/BF01896984}, } @Article{cluster:DeSoete+Desarbo+Furnas:1984, author = {De Soete, Geert and DeSarbo, Wayne S. and Furnas, George W. and Carroll, J. Douglas}, title = {The Estimation of Ultrametric and Path Length Trees from Rectangular Proximity Data}, year = 1984, journal = {Psychometrika}, volume = 49, pages = {289--310}, keywords = {Cluster analysis}, doi = {10.1007/BF02306021}, } @Article{cluster:DeSoete:1983, author = {De Soete, Geert}, title = {A Least Squares Algorithm for Fitting Additive Trees to Proximity Data}, year = 1983, journal = {Psychometrika}, volume = 48, pages = {621--626}, keywords = {Clustering}, doi = {10.1007/BF02293884}, } @Article{cluster:DeSoete:1984, author = {Geert de Soete}, title = {Ultrametric Tree Representations of Incomplete Dissimilarity Data}, journal = {Journal of Classification}, year = 1984, volume = 1, pages = {235--242}, doi = {10.1007/BF01890124}, } @Article{cluster:DeSoete:1986, author = {Geert de Soete}, title = {A Least Squares Algorithm for Fitting an Ultrametric Tree to a Dissimilarity Matrix}, journal = {Pattern Recognition Letters}, year = 1986, volume = 2, pages = {133--137}, doi = {10.1016/0167-8655(84)90036-9}, } @Manual{cluster:Dimitriadou+Hornik+Leisch:2005, title = {e1071: Misc Functions of the Department of Statistics (e1071), TU Wien}, author = {Evgenia Dimitriadou and Kurt Hornik and Friedrich Leisch and David Meyer and Andreas Weingessel}, year = 2005, note = {R package version 1.5-7}, url = {https://CRAN.R-project.org/package=e1071}, } @Article{cluster:Dimitriadou+Weingessel+Hornik:2002, author = {Evgenia Dimitriadou and Andreas Weingessel and Kurt Hornik}, title = {A Combination Scheme for Fuzzy Clustering}, journal = {International Journal of Pattern Recognition and Artificial Intelligence}, year = 2002, volume = 16, number = 7, pages = {901--912}, doi = {10.1142/S0218001402002052}, } @Manual{cluster:Dimitriadou:2005, title = {cclust: Convex Clustering Methods and Clustering Indexes}, author = {Evgenia Dimitriadou}, year = 2005, note = {R package version 0.6-12}, url = {https://CRAN.R-project.org/package=cclust}, } @Article{cluster:Dudoit+Fridlyand:2002, author = {Sandrine Dudoit and Jane Fridlyand}, title = {A Prediction-based Resampling Method for Estimating the Number of Clusters in a Dataset}, journal = {Genome Biology}, year = 2002, volume = 3, number = 7, pages = {1--21}, doi = {10.1186/gb-2002-3-7-research0036}, } @Article{cluster:Dudoit+Fridlyand:2003, author = {Sandrine Dudoit and Jane Fridlyand}, title = {Bagging to Improve the Accuracy of a Clustering Procedure}, journal = {Bioinformatics}, year = 2003, volume = 19, number = 9, pages = {1090--1099}, doi = {10.1093/bioinformatics/btg038}, } @InProceedings{cluster:Fern+Brodley:2004, author = {Xiaoli Zhang Fern and Carla E. Brodley}, title = {Solving Cluster Ensemble Problems by Bipartite Graph Partitioning}, booktitle = {ICML '04: Twenty-first International Conference on Machine Learning}, year = 2004, isbn = {1-58113-828-5}, location = {Banff, Alberta, Canada}, doi = {10.1145/1015330.1015414}, publisher = {ACM Press}, } @comment address = {New York, NY, USA}, @Book{cluster:Fiacco+McCormick:1968, author = {Anthony V. Fiacco and Garth P. McCormick}, title = {Nonlinear Programming: Sequential Unconstrained Minimization Techniques}, publisher = {John Willey \& Sons}, year = 1968, address = {New York}, } @Article{cluster:Forgy:1965, author = {Forgy, E. W.}, title = {Cluster Analysis of Multivariate Data: Efficiency vs Interpretability of Classifications}, journal = {Biometrics}, year = 1965, volume = 21, pages = {768--769}, } @Article{cluster:Fowlkes+Mallows:1983a, author = {Fowlkes, E. B. and Mallows, C. L.}, title = {A Method for Comparing Two Hierarchical Clusterings}, year = 1983, journal = {Journal of the American Statistical Association}, volume = 78, pages = {553--569}, keywords = {Similarity; Graphics}, doi = {10.1080/01621459.1983.10478008}, } @Article{cluster:Fowlkes+Mallows:1983b, author = {Fowlkes, E. B. and Mallows, C. L.}, title = {Reply to Comments on ``{A} Method for Comparing Two Hierarchical Clusterings''}, year = 1983, journal = {Journal of the American Statistical Association}, volume = 78, pages = {584--584}, } @Manual{cluster:Fraley+Raftery+Wehrens:2005, title = {mclust: Model-based Cluster Analysis}, author = {Chris Fraley and Adrian E. Raftery and Ron Wehrens}, year = 2005, note = {R package version 2.1-11}, url = {https://CRAN.R-project.org/package=mclust}, } @TechReport{cluster:Fraley+Raftery:2002, author = {Chris Fraley and Adrian E. Raftery}, title = {{MCLUST}: Software for Model-based Clustering, Discriminant Analysis, and Density Estimation}, institution = {Department of Statistics, University of Washington}, year = 2002, number = 415, month = {October}, url = {ftp://ftp.u.washington.edu/public/mclust/tr415.pdf}, } @Article{cluster:Fraley+Raftery:2003, author = {Chris Fraley and Adrian E. Raftery}, title = {Enhanced Model-based Clustering, Density Estimation, and Discriminant Analysis Software: {MCLUST}}, year = 2003, journal = {Journal of Classification}, volume = 20, number = 2, pages = {263--286}, keywords = {clustering software; Mixture models; Cluster analysis; supervised classification; unsupervised classification; software abstract}, doi = {10.1007/s00357-003-0015-3}, } @InProceedings{cluster:Fred+Jain:2002, author = {Ana L. N. Fred and Anil K. Jain}, title = {Data Clustering Using Evidence Accumulation}, booktitle = {Proceedings of the 16th International Conference on Pattern Recognition (ICPR 2002)}, pages = {276--280}, year = 2002, doi = {10.1109/ICPR.2002.1047450}, } @Article{cluster:Friedman+Hastie+Tibshirani:2000, author = {Jerome Friedman and Travor Hastie and Robert Tibshirani}, title = {Additive Logistic Regression: A Statistical View of Boosting}, journal = {The Annals of Statistics}, year = 2000, volume = 28, number = 2, pages = {337--407}, doi = {10.1214/aos/1016218223}, } @Book{cluster:Garey+Johnson:1979, author = {M. R. Garey and D. S. Johnson}, title = {Computers and Intractability: A Guide to the Theory of {NP}-Completeness}, address = {San Francisco}, publisher = {W. H. Freeman}, year = 1979, } @Article{cluster:Gaul+Schader:1988, author = {Wolfgang Gaul and Manfred Schader}, title = {Clusterwise Aggregation of Relations}, journal = {Applied Stochastic Models and Data Analysis}, year = 1988, volume = 4, pages = {273--282}, doi = {10.1002/asm.3150040406}, } @Manual{cluster:Gentleman+Whalen:2005, author = {Robert Gentleman and Elizabeth Whalen}, title = {graph: A Package to Handle Graph Data Structures}, year = 2005, note = {R package version 1.5.9}, url = {https://www.bioconductor.org/}, } @Article{cluster:Gordon+Vichi:1998, author = {Gordon, A. D. and Vichi, M.}, title = {Partitions of Partitions}, year = 1998, journal = {Journal of Classification}, volume = 15, pages = {265--285}, keywords = {Classification}, doi = {10.1007/s003579900034}, } @Article{cluster:Gordon+Vichi:2001, author = {Gordon, A. D. and Vichi, M.}, title = {Fuzzy Partition Models for Fitting a Set of Partitions}, year = 2001, journal = {Psychometrika}, volume = 66, number = 2, pages = {229--248}, keywords = {Classification; Cluster analysis; consensus fuzzy partition; membership function; three-way data}, doi = {10.1007/BF02294837}, } @Article{cluster:Gordon:1996, author = {Gordon, A. D.}, title = {A Survey of Constrained Classification}, year = 1996, journal = {Computational Statistics \& Data Analysis}, volume = 21, pages = {17--29}, keywords = {Model selection}, doi = {10.1016/0167-9473(95)00005-4}, } @Book{cluster:Gordon:1999, author = {A. D. Gordon}, title = {Classification}, address = {Boca Raton, Florida}, publisher = {Chapman \& Hall/CRC}, year = 1999, pages = 256, edition = {2nd}, } @Article{cluster:Grundel+Oliveira+Pardalos:2005, author = {Don Grundel and Carlos A.S. Oliveira and Panos M. Pardalos and Eduardo Pasiliao}, title = {Asymptotic Results for Random Multidimensional Assignment Problems}, journal = {Computational Optimization and Applications}, year = 2005, volume = 31, number = 3, pages = {275--293}, doi = {10.1007/s10589-005-3227-0}, } @Article{cluster:Guha+Rastogi+Shim:2000, author = {Sudipto Guha and Rajeev Rastogi and Kyuseok Shim}, title = {{ROCK}: A Robust Clustering Algorithm for Categorical Attributes}, journal = {Information Systems}, year = 2000, volume = 25, number = 5, pages = {345--366}, doi = {10.1016/S0306-4379(00)00022-3}, } @Article{cluster:Gusfield:2002, author = {Dan Gusfield}, title = {Partition-Distance: A Problem and Class of Perfect Graphs Arising in Clustering}, journal = {Information Processing Letters}, year = 2002, volume = 82, pages = {159--164}, doi = {10.1016/S0020-0190(01)00263-0}, } @Manual{cluster:Hansen:2005, title = {optmatch: Functions for Optimal Matching}, author = {Ben B. Hansen}, year = 2005, note = {R package version 0.1-3}, url = {https://CRAN.R-project.org/package=optmatch}, } @Article{cluster:Hartigan+Wong:1979, author = {Hartigan, J. A. and Wong, M. A.}, title = {A $K$-Means Clustering Algorithm}, journal = {Applied Statistics}, year = 1979, volume = 28, pages = {100--108}, doi = {10.2307/2346830}, } @Article{cluster:Hoeting+Madigan+Raftery:1999, author = {Jennifer Hoeting and David Madigan and Adrian Raftery and Chris Volinsky}, title = {Bayesian Model Averaging: A Tutorial}, journal = {Statistical Science}, year = 1999, volume = 14, pages = {382--401}, doi = {10.1214/ss/1009212519}, } @Manual{cluster:Hornik+Hothorn+Karatzoglou:2006, title = {RWeka: {R/Weka} Interface}, author = {Kurt Hornik and Torsten Hothorn and Alexandros Karatzoglou}, year = 2006, note = {R package version 0.2-0}, url = {https://CRAN.R-project.org/package=RWeka}, } @InProceedings{cluster:Hornik:2005a, author = {Kurt Hornik}, title = {Cluster Ensembles}, booktitle = {Classification -- The Ubiquitous Challenge}, pages = {65--72}, year = 2005, editor = {Claus Weihs and Wolfgang Gaul}, publisher = {Springer-Verlag}, note = {Proceedings of the 28th Annual Conference of the Gesellschaft f{\"u}r Klassifikation e.V., University of Dortmund, March 9--11, 2004}, } @comment address = {Heidelberg}, @Article{cluster:Hornik:2005b, author = {Kurt Hornik}, title = {A {CLUE} for {CLUster Ensembles}}, year = 2005, journal = {Journal of Statistical Software}, volume = 14, number = 12, month = {September}, doi = {10.18637/jss.v014.i12}, } @Misc{cluster:Hubert+Arabie+Meulman:2004, author = {Lawrence Hubert and Phipps Arabie and Jacqueline Meulman}, title = {The Structural Representation of Proximity Matrices With {MATLAB}}, year = 2004, url = {http://cda.psych.uiuc.edu/srpm_mfiles/}, } @Book{cluster:Hubert+Arabie+Meulman:2006, author = {Lawrence Hubert and Phipps Arabie and Jacqueline Meulman}, title = {The Structural Representation of Proximity Matrices With {MATLAB}}, publisher = {SIAM}, address = {Philadelphia}, year = 2006, doi = {10.1137/1.9780898718355}, } @Article{cluster:Hubert+Arabie:1985, author = {Hubert, Lawrence and Arabie, Phipps}, title = {Comparing Partitions}, year = 1985, journal = {Journal of Classification}, volume = 2, pages = {193--218}, keywords = {Agreement; Association measure; Consensus index}, doi = {10.1007/bf01908075}, } @Article{cluster:Hubert+Arabie:1994, author = {Hubert, Lawrence and Arabie, Phipps}, title = {The Analysis of Proximity Matrices through Sums of Matrices Having (anti-) {R}obinson Forms}, year = 1994, journal = {British Journal of Mathematical and Statistical Psychology}, volume = 47, pages = {1--40}, doi = {10.1111/j.2044-8317.1994.tb01023.x}, } @Article{cluster:Hubert+Arabie:1995, author = {Hubert, Lawrence and Arabie, Phipps}, title = {Iterative Projection Strategies for the Least Squares Fitting of Tree Structures to Proximity Data}, year = 1995, journal = {British Journal of Mathematical and Statistical Psychology}, volume = 48, pages = {281--317}, keywords = {Graph theory}, doi = {10.1111/j.2044-8317.1995.tb01065.x}, } @Article{cluster:Hubert+Baker:1978, author = {Hubert, Lawrence J. and Baker, Frank B.}, title = {Evaluating the Conformity of Sociometric Measurements}, year = 1978, journal = {Psychometrika}, volume = 43, pages = {31--42}, keywords = {Permutation test; Nonparametric test}, doi = {10.1007/BF02294087}, } @Article{cluster:Hutchinson:1989, author = {Hutchinson, J. Wesley}, title = {{NETSCAL}: {A} Network Scaling Algorithm for Nonsymmetric Proximity Data}, year = 1989, journal = {Psychometrika}, volume = 54, pages = {25--51}, keywords = {Similarity; Graph theory}, doi = {10.1007/BF02294447}, } @Article{cluster:Karatzoglou+Smola+Hornik:2004, title = {kernlab -- An {S4} Package for Kernel Methods in {R}}, author = {Alexandros Karatzoglou and Alex Smola and Kurt Hornik and Achim Zeileis}, journal = {Journal of Statistical Software}, year = 2004, volume = 11, number = 9, pages = {1--20}, doi = {10.18637/jss.v011.i09}, } @Article{cluster:Katz+Powell:1953, author = {L. Katz and J. H. Powell}, title = {A Proposed Index of the Conformity of one Sociometric Measurement to Another}, journal = {Psychometrika}, year = 1953, volume = 18, pages = {249--256}, doi = {10.1007/BF02289063}, } @Book{cluster:Kaufman+Rousseeuw:1990, author = {Kaufman, Leonard and Rousseeuw, Peter J.}, title = {Finding Groups in Data: An Introduction to Cluster Analysis}, year = 1990, pages = 342, publisher = {John Wiley \& Sons}, } @Article{cluster:Klauer+Carroll:1989, author = {Klauer, K. C. and Carroll, J. D.}, title = {A Mathematical Programming Approach to Fitting General Graphs}, year = 1989, journal = {Journal of Classification}, volume = 6, pages = {247--270}, keywords = {Multivariate analysis; Proximity data}, doi = {10.1007/BF01908602}, } @Article{cluster:Klauer+Carroll:1991, author = {Klauer, K. C. and Carroll, J. O.}, title = {A Comparison of Two Approaches to Fitting Directed Graphs to Nonsymmetric Proximity Measures}, year = 1991, journal = {Journal of Classification}, volume = 8, pages = {251--268}, keywords = {Clustering}, doi = {10.1007/BF02616242}, } @Article{cluster:Krieger+Green:1999, author = {Abba M. Krieger and Paul E. Green}, title = {A Generalized {Rand}-index Method for Consensus Clustering of Separate Partitions of the Same Data Base}, journal = {Journal of Classification}, year = 1999, volume = 16, pages = {63--89}, doi = {10.1007/s003579900043}, } @Article{cluster:Krivanek+Moravek:1986, author = {M. Krivanek and J. Moravek}, title = {{NP}-hard Problems in Hierarchical Tree Clustering}, journal = {Acta Informatica}, year = 1986, volume = 23, pages = {311--323}, doi = {10.1007/BF00289116}, } @InProceedings{cluster:Krivanek:1986, author = {Krivanek, Mirko}, title = {On the Computational Complexity of Clustering}, year = 1986, booktitle = {Data Analysis and Informatics 4}, editor = {Diday, E. and Escoufier, Y. and Lebart, L. and Pages, J. and Schektman, Y. and Tomassone, R.}, publisher = {Elsevier/North-Holland}, pages = {89--96}, } @comment address = {Amsterdam}, @Article{cluster:Lange+Roth+Braun:2004, author = {Tilman Lange and Volker Roth and Mikio L. Braun and Joachim M. Buhmann}, title = {Stability-Based Validation of Clustering Solutions}, journal = {Neural Computation}, year = 2004, volume = 16, number = 6, pages = {1299--1323}, doi = {10.1162/089976604773717621}, } @Manual{cluster:Leisch+Dimitriadou:2005, title = {mlbench: Machine Learning Benchmark Problems}, author = {Friedrich Leisch and Evgenia Dimitriadou}, year = 2005, note = {R package version 1.0-1}, url = {https://CRAN.R-project.org/package=mlbench}, } @TechReport{cluster:Leisch:1999, author = {Friedrich Leisch}, title = {Bagged Clustering}, institution = {SFB ``Adaptive Information Systems and Modeling in Economics and Management Science''}, year = 1999, type = {Working Paper}, number = 51, month = {August}, url = {https://epub.wu.ac.at/id/eprint/1272}, } @Article{cluster:Leisch:2004, title = {{FlexMix}: A General Framework for Finite Mixture Models and Latent Class Regression in {R}}, author = {Friedrich Leisch}, journal = {Journal of Statistical Software}, year = 2004, volume = 11, number = 8, doi = {10.18637/jss.v011.i08}, } @Manual{cluster:Leisch:2005, author = {Friedrich Leisch}, title = {flexclust: Flexible Cluster Algorithms}, note = {R package 0.7-0}, year = 2005, url = {https://CRAN.R-project.org/package=flexclust}, } @Article{cluster:Leisch:2006a, author = {Friedrich Leisch}, title = {A Toolbox for $K$-Centroids Cluster Analysis}, journal = {Computational Statistics and Data Analysis}, year = 2006, volume = 51, number = 2, pages = {526--544}, doi = {10.1016/j.csda.2005.10.006}, } @Unpublished{cluster:Lloyd:1957, author = {Lloyd, S. P.}, title = {Least Squares Quantization in {PCM}}, note = {Technical Note, Bell Laboratories}, year = 1957, } @Article{cluster:Lloyd:1982, author = {Lloyd, S. P.}, title = {Least Squares Quantization in {PCM}}, journal = {IEEE Transactions on Information Theory}, year = 1982, volume = 28, pages = {128--137}, doi = {10.1109/TIT.1982.1056489}, } @Article{cluster:Margush+Mcmorris:1981, author = {T. Margush and F. R. McMorris}, title = {Consensus $n$-Trees}, journal = {Bulletin of Mathematical Biology}, year = 1981, volume = 43, number = 2, pages = {239--244}, doi = {10.1007/BF02459446}, } @InProceedings{cluster:Meila:2003, author = {Marina Meila}, title = {Comparing Clusterings by the Variation of Information}, booktitle = {Learning Theory and Kernel Machines}, editor = {Bernhard Sch{\"o}lkopf and Manfred K. Warmuth}, series = {Lecture Notes in Computer Science}, publisher = {Springer-Verlag}, volume = 2777, year = 2003, pages = {173--187}, ee = {http://springerlink.metapress.com/openurl.asp?genre=article&issn=0302-9743&volume=2777&spage=173}, bibsource = {DBLP, http://dblp.uni-trier.de}, } @comment address = {Heidelberg}, @Article{cluster:Messatfa:1992, author = {Messatfa, H.}, title = {An Algorithm to Maximize the Agreement Between Partitions}, year = 1992, journal = {Journal of Classification}, volume = 9, pages = {5--15}, keywords = {Association; Contingency table}, doi = {10.1007/BF02618465}, } @Article{cluster:Miller+Nicely:1955, author = {G. A. Miller and P. E. Nicely}, title = {An Analysis of Perceptual Confusions Among some {English} Consonants}, journal = {Journal of the Acoustical Society of America}, year = 1955, volume = 27, pages = {338--352}, doi = {10.1121/1.1907526}, } @Book{cluster:Mirkin:1996, author = {Boris G. Mirkin}, title = {Mathematical Classification and Clustering}, year = 1996, pages = 428, publisher = {Kluwer Academic Publishers Group}, } @Article{cluster:Monti+Tamayo+Mesirov:2003, author = {Stefano Monti and Pablo Tamayo and Jill Mesirov and Todd Golub}, title = {Consensus Clustering: A Resampling-based Method for Class Discovery and Visualization of Gene Expression Microarray Data}, journal = {Machine Learning}, volume = 52, number = {1--2}, year = 2003, issn = {0885-6125}, pages = {91--118}, publisher = {Kluwer Academic Publishers}, address = {Hingham, MA, USA}, doi = {10.1023/A:1023949509487}, } @Article{cluster:Oliveira+Pardalos:2004, author = {Carlos A. S. Oliveira and Panos M. Pardalos}, title = {Randomized Parallel Algorithms for the Multidimensional Assignment Problem}, journal = {Applied Numerical Mathematics}, year = 2004, volume = 49, number = 1, pages = {117--133}, month = {April}, doi = {10.1016/j.apnum.2003.11.014}, } @Book{cluster:Papadimitriou+Steiglitz:1982, author = {Christos Papadimitriou and Kenneth Steiglitz}, title = {Combinatorial Optimization: Algorithms and Complexity}, publisher = {Prentice Hall}, year = 1982, address = {Englewood Cliffs}, } @Manual{cluster:R:2005, title = {R: A Language and Environment for Statistical Computing}, author = {{R Development Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = 2005, note = {{ISBN} 3-900051-07-0}, url = {https://www.R-project.org/}, } @article{cluster:Rajski:1961, author = {C. Rajski}, title = {A Metric Space of Discrete Probability Distributions}, journal = {Information and Control}, year = 1961, volume = 4, number = 4, pages = {371--377}, doi = {10.1016/S0019-9958(61)80055-7}, } @Article{cluster:Rand:1971, author = {William M. Rand}, title = {Objective Criteria for the Evaluation of Clustering Methods}, journal = {Journal of the American Statistical Association}, year = 1971, volume = 66, number = 336, pages = {846--850}, keywords = {Pattern recognition}, doi = {10.2307/2284239}, } @Article{cluster:Rosenberg+Kim:1975, author = {S. Rosenberg and M. P. Kim}, title = {The Method of Sorting as a Data-Gathering Procedure in Multivariate Research}, journal = {Multivariate Behavioral Research}, year = 1975, volume = 10, pages = {489--502}, doi = {10.1207/s15327906mbr1004_7}, } @InCollection{cluster:Rosenberg:1982, author = {S. Rosenberg}, title = {The Method of Sorting in Multivariate Research with Applications Selected from Cognitive Psychology and Person Perception}, booktitle = {Multivariate Applications in the Social Sciences}, pages = {117--142}, address = {Hillsdale, New Jersey}, publisher = {Erlbaum}, year = 1982, editor = {N. Hirschberg and L. G. Humphreys}, } @InProceedings{cluster:Roth+Lange+Braun:2002, author = {Volker Roth and Tilman Lange and Mikio Braun and Joachim M. Buhmann}, title = {A Resampling Approach to Cluster Validation}, booktitle = {{COMPSTAT} 2002 -- Proceedings in Computational Statistics}, pages = {123--128}, year = 2002, editor = {Wolfgang H{\"a}rdle and Bernd R{\"o}nz}, publisher = {Physika Verlag}, note = {ISBN 3-7908-1517-9}, } @comment address = {Heidelberg, Germany}, @Manual{cluster:Rousseeuw+Struyf+Hubert:2005, title = {cluster: Functions for Clustering (by Rousseeuw et al.)}, author = {Peter Rousseeuw and Anja Struyf and Mia Hubert and Martin Maechler}, year = 2005, note = {R package version 1.9.8}, url = {https://CRAN.R-project.org/package=cluster}, } @InCollection{cluster:Roux:1988, author = {M. Roux}, title = {Techniques of Approximation for Building Two Tree Structures}, booktitle = {Recent Developments in Clustering and Data Analysis}, pages = {151--170}, publisher = {Academic Press}, year = 1988, editor = {C. Hayashi and E. Diday and M. Jambu and N. Ohsumi}, address = {New York}, } @article{cluster:Rubin:1967, author = {Jerrold Rubin}, title = {Optimal Classification into Groups: An Approach for Solving the Taxonomy Problem}, journal = {Journal of Theoretical Biology}, year = 1967, volume = 15, number = 1, pages = {103--144}, doi = {10.1016/0022-5193(67)90046-X}, } @Article{cluster:Sato+Sato:1994, author = {M. Sato and Y. Sato}, title = {On a Multicriteria Fuzzy Clustering Method for 3-way Data}, journal = {International Journal of Uncertainty, Fuzziness and Knowledge-based Systems}, year = 1994, volume = 2, pages = {127--142}, doi = {10.1142/S0218488594000122}, } @Article{cluster:Smith:2000, author = {Smith, Thomas J.}, title = {${L}_1$ Optimization under Linear Inequality Constraints}, year = 2000, journal = {Journal of Classification}, volume = 17, number = 2, pages = {225--242}, keywords = {$L_1$-norm; Ultrametric; stuctural representation}, doi = {10.1007/s003570000020}, } @Article{cluster:Smith:2001, author = {Smith, Thomas J.}, title = {Constructing Ultrametric and Additive Trees Based on the ${L}_1$ Norm}, year = 2001, journal = {Journal of Classification}, volume = 18, number = 2, pages = {185--207}, keywords = {iteratively re-weighted iterative projection (IRIP); Combinatorial probability; explicit machine computation; Combinatorics; Trees; Graph theory; Linear regression; probabilistic Monte Carlo methods}, doi = {10.1007/s00357-001-0015-0}, } @Article{cluster:Sokal+Rohlf:1962, author = {R. R. Sokal and F. J. Rohlf}, title = {The Comparisons of Dendrograms by Objective Methods}, journal = {Taxon}, year = 1962, volume = 11, pages = {33--40}, doi = {10.2307/1217208}, } @Article{cluster:Strehl+Ghosh:2003a, author = {Alexander Strehl and Joydeep Ghosh}, title = {Cluster Ensembles -- {A} Knowledge Reuse Framework for Combining Multiple Partitions}, journal = {Journal of Machine Learning Research}, volume = 3, year = 2003, issn = {1533-7928}, pages = {583--617}, publisher = {MIT Press}, url = {https://www.jmlr.org/papers/volume3/strehl02a/strehl02a.pdf}, } @Article{cluster:Strehl+Ghosh:2003b, author = {Alexander Strehl and Joydeep Ghosh}, title = {Relationship-based Clustering and Visualization for High-Dimensional Data Mining}, journal = {{INFORMS} Journal on Computing}, year = 2003, volume = 15, issue = 2, pages = {208--230}, ISSN = {1526-5528}, doi = {10.1287/ijoc.15.2.208.14448}, } @Article{cluster:Struyf+Hubert+Rousseeuw:1996, author = {Anja Struyf and Mia Hubert and Peter Rousseeuw}, title = {Clustering in an Object-Oriented Environment}, journal = {Journal of Statistical Software}, year = 1996, volume = 1, number = 4, doi = {10.18637/jss.v001.i04}, } @Article{cluster:Tibshirani+Walther+Hastie:2001, author = {Tibshirani, Robert and Walther, Guenther and Hastie, Trevor}, title = {Estimating the Number of Clusters in a Data Set Via the Gap Statistic}, year = 2001, journal = {Journal of the Royal Statistical Society, Series B: Statistical Methodology}, volume = 63, number = 2, pages = {411--423}, keywords = {Clustering; groups; Hierarchy; $k$-means; Uniform distribution}, doi = {10.1111/1467-9868.00293}, } @Article{cluster:Tibshirani+Walther:2005, author = {Tibshirani, Robert and Walther, Guenther}, title = {Cluster Validation by Prediction Strength}, year = 2005, journal = {Journal of Computational and Graphical Statistics}, volume = 14, number = 3, pages = {511--528}, keywords = {number of clusters; prediction; Unsupervised learning}, doi = {10.1198/106186005X59243}, } @InProceedings{cluster:Topchy+Jain+Punch:2003, author = {A. Topchy and A. Jain and W. Punch}, title = {Combining Multiple Weak Clusterings}, booktitle = {Proceedings of the Third IEEE International Conference on Data Mining (ICDM'03)}, year = 2003, doi = {10.1109/ICDM.2003.1250937}, } @Article{cluster:Vichi:1999, author = {Vichi, Maurizio}, title = {One-mode Classification of a Three-way Data Matrix}, year = 1999, journal = {Journal of Classification}, volume = 16, pages = {27--44}, keywords = {Cluster analysis}, doi = {10.1007/s003579900041}, } @Article{cluster:Wallace:1983, author = {Wallace, David L.}, title = {Comments on ``{A} Method for Comparing Two Hierarchical Clusterings''}, year = 1983, journal = {Journal of the American Statistical Association}, volume = 78, pages = {569--576}, doi = {10.2307/2288118}, } @Inproceedings{cluster:Zhou+Li+Zha:2005, author = {Ding Zhou and Jia Li and Hongyuan Zha}, title = {A New {Mallows} Distance Based Metric for Comparing Clusterings}, booktitle = {ICML '05: Proceedings of the 22nd International Conference on Machine Learning}, year = 2005, isbn = {1-59593-180-5}, pages = {1028--1035}, location = {Bonn, Germany}, doi = {10.1145/1102351.1102481}, publisher = {ACM Press}, address = {New York, NY, USA}, } %%% Local Variables: *** %%% bibtex-maintain-sorted-entries: t *** %%% End: *** clue/vignettes/clue.Rnw0000644000175100001440000016521512734170652014671 0ustar hornikusers\documentclass[fleqn]{article} \usepackage[round,longnamesfirst]{natbib} \usepackage{graphicx,keyval,hyperref,doi} \newcommand\argmin{\mathop{\mathrm{arg min}}} \newcommand\trace{\mathop{\mathrm{tr}}} \newcommand\R{{\mathbb{R}}} \newcommand{\pkg}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \let\code=\texttt \newcommand{\file}[1]{\sQuote{\textsf{#1}}} \newcommand{\class}[1]{\code{"#1"}} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \date{2007-06-28} \title{A CLUE for CLUster Ensembles} \author{Kurt Hornik} %% \VignetteIndexEntry{CLUster Ensembles} \sloppy{} \begin{document} \maketitle \begin{abstract} Cluster ensembles are collections of individual solutions to a given clustering problem which are useful or necessary to consider in a wide range of applications. The R package~\pkg{clue} provides an extensible computational environment for creating and analyzing cluster ensembles, with basic data structures for representing partitions and hierarchies, and facilities for computing on these, including methods for measuring proximity and obtaining consensus and ``secondary'' clusterings. \end{abstract} <>= options(width = 60) library("clue") @ % \section{Introduction} \label{sec:introduction} \emph{Cluster ensembles} are collections of clusterings, which are all of the same ``kind'' (e.g., collections of partitions, or collections of hierarchies), of a set of objects. Such ensembles can be obtained, for example, by varying the (hyper)parameters of a ``base'' clustering algorithm, by resampling or reweighting the set of objects, or by employing several different base clusterers. Questions of ``agreement'' in cluster ensembles, and obtaining ``consensus'' clusterings from it, have been studied in several scientific communities for quite some time now. A special issue of the Journal of Classification was devoted to ``Comparison and Consensus of Classifications'' \citep{cluster:Day:1986} almost two decades ago. The recent popularization of ensemble methods such as Bayesian model averaging \citep{cluster:Hoeting+Madigan+Raftery:1999}, bagging \citep{cluster:Breiman:1996} and boosting \citep{cluster:Friedman+Hastie+Tibshirani:2000}, typically in a supervised leaning context, has also furthered the research interest in using ensemble methods to improve the quality and robustness of cluster solutions. Cluster ensembles can also be utilized to aggregate base results over conditioning or grouping variables in multi-way data, to reuse existing knowledge, and to accommodate the needs of distributed computing, see e.g.\ \cite{cluster:Hornik:2005a} and \cite{cluster:Strehl+Ghosh:2003a} for more information. Package~\pkg{clue} is an extension package for R~\citep{cluster:R:2005} providing a computational environment for creating and analyzing cluster ensembles. In Section~\ref{sec:structures+algorithms}, we describe the underlying data structures, and the functionality for measuring proximity, obtaining consensus clusterings, and ``secondary'' clusterings. Four examples are discussed in Section~\ref{sec:examples}. Section~\ref{sec:outlook} concludes the paper. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{cluster:Hornik:2005b}. \section{Data structures and algorithms} \label{sec:structures+algorithms} \subsection{Partitions and hierarchies} Representations of clusterings of objects greatly vary across the multitude of methods available in R packages. For example, the class ids (``cluster labels'') for the results of \code{kmeans()} in base package~\pkg{stats}, \code{pam()} in recommended package~\pkg{cluster}~\citep{cluster:Rousseeuw+Struyf+Hubert:2005, cluster:Struyf+Hubert+Rousseeuw:1996}, and \code{Mclust()} in package~\pkg{mclust}~\citep{cluster:Fraley+Raftery+Wehrens:2005, cluster:Fraley+Raftery:2003}, are available as components named \code{cluster}, \code{clustering}, and \code{classification}, respectively, of the R objects returned by these functions. In many cases, the representations inherit from suitable classes. (We note that for versions of R prior to 2.1.0, \code{kmeans()} only returned a ``raw'' (unclassed) result, which was changed alongside the development of \pkg{clue}.) We deal with this heterogeneity of representations by providing getters for the key underlying data, such as the number of objects from which a clustering was obtained, and predicates, e.g.\ for determining whether an R object represents a partition of objects or not. These getters, such as \code{n\_of\_objects()}, and predicates are implemented as S3 generics, so that there is a \emph{conceptual}, but no formal class system underlying the predicates. Support for classed representations can easily be added by providing S3 methods. \subsubsection{Partitions} The partitions considered in \pkg{clue} are possibly soft (``fuzzy'') partitions, where for each object~$i$ and class~$j$ there is a non-negative number~$\mu_{ij}$ quantifying the ``belongingness'' or \emph{membership} of object~$i$ to class~$j$, with $\sum_j \mu_{ij} = 1$. For hard (``crisp'') partitions, all $\mu_{ij}$ are in $\{0, 1\}$. We can gather the $\mu_{ij}$ into the \emph{membership matrix} $M = [\mu_{ij}]$, where rows correspond to objects and columns to classes. The \emph{number of classes} of a partition, computed by function \code{n\_of\_classes()}, is the number of $j$ for which $\mu_{ij} > 0$ for at least one object~$i$. This may be less than the number of ``available'' classes, corresponding to the number of columns in a membership matrix representing the partition. The predicate functions \code{is.cl\_partition()}, \code{is.cl\_hard\_partition()}, and \code{is.cl\_soft\_partition()} are used to indicate whether R objects represent partitions of objects of the respective kind, with hard partitions as characterized above (all memberships in $\{0, 1\}$). (Hence, ``fuzzy clustering'' algorithms can in principle also give a hard partition.) \code{is.cl\_partition()} and \code{is.cl\_hard\_partition()} are generic functions; \code{is.cl\_soft\_partition()} gives true iff \code{is.cl\_partition()} is true and \code{is.cl\_hard\_partition()} is false. For R objects representing partitions, function \code{cl\_membership()} computes an R object with the membership values, currently always as a dense membership matrix with additional attributes. This is obviously rather inefficient for computations on hard partitions; we are planning to add ``canned'' sparse representations (using the vector of class ids) in future versions. Function \code{as.cl\_membership()} can be used for coercing \dQuote{raw} class ids (given as atomic vectors) or membership values (given as numeric matrices) to membership objects. Function \code{cl\_class\_ids()} determines the class ids of a partition. For soft partitions, the class ids returned are those of the \dQuote{nearest} hard partition obtained by taking the class ids of the (first) maximal membership values. Note that the cardinality of the set of the class ids may be less than the number of classes in the (soft) partition. Many partitioning methods are based on \emph{prototypes} (``centers''). In typical cases, these are points~$p_j$ in the same feature space the measurements~$x_i$ on the objects~$i$ to be partitioned are in, so that one can measure distance between objects and prototypes, and e.g.\ classify objects to their closest prototype. Such partitioning methods can also induce partitions of the entire feature space (rather than ``just'' the set of objects to be partitioned). Currently, package \pkg{clue} has only minimal support for this ``additional'' structure, providing a \code{cl\_prototypes()} generic for extracting the prototypes, and is mostly focused on computations on partitions which are based on their memberships. Many algorithms resulting in partitions of a given set of objects can be taken to induce a partition of the underlying feature space for the measurements on the objects, so that class memberships for ``new'' objects can be obtained from the induced partition. Examples include partitions based on assigning objects to their ``closest'' prototypes, or providing mixture models for the distribution of objects in feature space. Package~\pkg{clue} provides a \code{cl\_predict()} generic for predicting the class memberships of new objects (if possible). Function \code{cl\_fuzziness()} computes softness (fuzziness) measures for (ensembles) of partitions. Built-in measures are the partition coefficient \label{PC} and partition entropy \citep[e.g.,][]{cluster:Bezdek:1981}, with an option to normalize in a way that hard partitions and the ``fuzziest'' possible partition (where all memberships are the same) get fuzziness values of zero and one, respectively. Note that this normalization differs from ``standard'' ones in the literature. In the sequel, we shall also use the concept of the \emph{co-membership matrix} $C(M) = M M'$, where $'$ denotes matrix transposition, of a partition. For hard partitions, an entry $c_{ij}$ of $C(M)$ is 1 iff the corresponding objects $i$ and $j$ are in the same class, and 0 otherwise. \subsubsection{Hierarchies} The hierarchies considered in \pkg{clue} are \emph{total indexed hierarchies}, also known as \emph{$n$-valued trees}, and hence correspond in a one-to-one manner to \emph{ultrametrics} (distances $u_{ij}$ between pairs of objects $i$ and $j$ which satisfy the ultrametric constraint $u_{ij} = \max(u_{ik}, u_{jk})$ for all triples $i$, $j$, and $k$). See e.g.~\citet[Page~69--71]{cluster:Gordon:1999}. Function \code{cl\_ultrametric(x)} computes the associated ultrametric from an R object \code{x} representing a hierarchy of objects. If \code{x} is not an ultrametric, function \code{cophenetic()} in base package~\pkg{stats} is used to obtain the ultrametric (also known as cophenetic) distances from the hierarchy, which in turn by default calls the S3 generic \code{as.hclust()} (also in \pkg{stats}) on the hierarchy. Support for classes which represent hierarchies can thus be added by providing \code{as.hclust()} methods for this class. In R~2.1.0 or better (again as part of the work on \pkg{clue}), \code{cophenetic} is an S3 generic as well, and one can also more directly provide methods for this if necessary. In addition, there is a generic function \code{as.cl\_ultrametric()} which can be used for coercing \emph{raw} (non-classed) ultrametrics, represented as numeric vectors (of the lower-half entries) or numeric matrices, to ultrametric objects. Finally, the generic predicate function \code{is.cl\_hierarchy()} is used to determine whether an R object represents a hierarchy or not. Ultrametric objects can also be coerced to classes~\class{dendrogram} and \class{hclust} (from base package~\pkg{stats}), and hence in particular use the \code{plot()} methods for these classes. By default, plotting an ultrametric object uses the plot method for dendrograms. Obtaining a hierarchy on a given set of objects can be thought of as transforming the pairwise dissimilarities between the objects (which typically do not yet satisfy the ultrametric constraints) into an ultrametric. Ideally, this ultrametric should be as close as possible to the dissimilarities. In some important cases, explicit solutions are possible (e.g., ``standard'' hierarchical clustering with single or complete linkage gives the optimal ultrametric dominated by or dominating the dissimilarities, respectively). On the other hand, the problem of finding the closest ultrametric in the least squares sense is known to be NP-hard \citep{cluster:Krivanek+Moravek:1986,cluster:Krivanek:1986}. One important class of heuristics for finding least squares fits is based on iterative projection on convex sets of constraints \citep{cluster:Hubert+Arabie:1995}. \label{SUMT} Function \code{ls\_fit\_ultrametric()} follows \cite{cluster:DeSoete:1986} to use an SUMT \citep[Sequential Unconstrained Minimization Technique;][]{cluster:Fiacco+McCormick:1968} approach in turn simplifying the suggestions in \cite{cluster:Carroll+Pruzansky:1980}. Let $L(u)$ be the function to be minimized over all $u$ in some constrained set $\mathcal{U}$---in our case, $L(u) = \sum (d_{ij}-u_{ij})^2$ is the least squares criterion, and $\mathcal{U}$ is the set of all ultrametrics $u$. One iteratively minimizes $L(u) + \rho_k P(u)$, where $P(u)$ is a non-negative function penalizing violations of the constraints such that $P(u)$ is zero iff $u \in \mathcal{U}$. The $\rho$ values are increased according to the rule $\rho_{k+1} = q \rho_k$ for some constant $q > 1$, until convergence is obtained in the sense that e.g.\ the Euclidean distance between successive solutions $u_k$ and $u_{k+1}$ is small enough. Optionally, the final $u_k$ is then suitably projected onto $\mathcal{U}$. For \code{ls\_fit\_ultrametric()}, we obtain the starting value $u_0$ by \dQuote{random shaking} of the given dissimilarity object, and use the penalty function $P(u) = \sum_{\Omega} (u_{ij} - u_{jk}) ^ 2$, were $\Omega$ contains all triples $i, j, k$ for which $u_{ij} \le \min(u_{ik}, u_{jk})$ and $u_{ik} \ne u_{jk}$, i.e., for which $u$ violates the ultrametric constraints. The unconstrained minimizations are carried out using either \code{optim()} or \code{nlm()} in base package~\pkg{stats}, with analytic gradients given in \cite{cluster:Carroll+Pruzansky:1980}. This ``works'', even though we note however that $P$ is not even a continuous function, which seems to have gone unnoticed in the literature! (Consider an ultrametric $u$ for which $u_{ij} = u_{ik} < u_{jk}$ for some $i, j, k$ and define $u(\delta)$ by changing the $u_{ij}$ to $u_{ij} + \delta$. For $u$, both $(i,j,k)$ and $(j,i,k)$ are in the violation set $\Omega$, whereas for all $\delta$ sufficiently small, only $(j,i,k)$ is the violation set for $u(\delta)$. Hence, $\lim_{\delta\to 0} P(u(\delta)) = P(u) + (u_{ij} - u_{ik})^2$. This shows that $P$ is discontinuous at all non-constant $u$ with duplicated entries. On the other hand, it is continuously differentiable at all $u$ with unique entries.) Hence, we need to turn off checking analytical gradients when using \code{nlm()} for minimization. The default optimization using conjugate gradients should work reasonably well for medium to large size problems. For \dQuote{small} ones, using \code{nlm()} is usually faster. Note that the number of ultrametric constraints is of the order $n^3$, suggesting to use the SUMT approach in favor of \code{constrOptim()} in \pkg{stats}. It should be noted that the SUMT approach is a heuristic which can not be guaranteed to find the global minimum. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. \subsubsection{Extensibility} The methods provided in package~\pkg{clue} handle the partitions and hierarchies obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}~\citep{cluster:Hornik+Hothorn+Karatzoglou:2006}, \pkg{cba}~\citep{cluster:Buchta+Hahsler:2005}, \pkg{cclust}~\citep{cluster:Dimitriadou:2005}, \pkg{cluster}, \pkg{e1071}~\citep{cluster:Dimitriadou+Hornik+Leisch:2005}, \pkg{flexclust}~\citep{cluster:Leisch:2006a}, \pkg{flexmix}~\citep{cluster:Leisch:2004}, \pkg{kernlab}~\citep{cluster:Karatzoglou+Smola+Hornik:2004}, and \pkg{mclust} (and of course, \pkg{clue} itself). Extending support to other packages is straightforward, provided that clusterings are instances of classes. Suppose e.g.\ that a package has a function \code{glvq()} for ``generalized'' (i.e., non-Euclidean) Learning Vector Quantization which returns an object of class~\class{glvq}, in turn being a list with component \code{class\_ids} containing the class ids. To integrate this into the \pkg{clue} framework, all that is necessary is to provide the following methods. <<>>= cl_class_ids.glvq <- function(x) as.cl_class_ids(x$class_ids) is.cl_partition.glvq <- function(x) TRUE is.cl_hard_partition.glvq <- function(x) TRUE @ % $ \subsection{Cluster ensembles} Cluster ensembles are realized as lists of clusterings with additional class information. All clusterings in an ensemble must be of the same ``kind'' (i.e., either all partitions as known to \code{is.cl\_partition()}, or all hierarchies as known to \code{is.cl\_hierarchy()}, respectively), and have the same number of objects. If all clusterings are partitions, the list realizing the ensemble has class~\class{cl\_partition\_ensemble} and inherits from \class{cl\_ensemble}; if all clusterings are hierarchies, it has class~\class{cl\_hierarchy\_ensemble} and inherits from \class{cl\_ensemble}. Empty ensembles cannot be categorized according to the kind of clusterings they contain, and hence only have class~\class{cl\_ensemble}. Function \code{cl\_ensemble()} creates a cluster ensemble object from clusterings given either one-by-one, or as a list passed to the \code{list} argument. As unclassed lists could be used to represent single clusterings (in particular for results from \code{kmeans()} in versions of R prior to 2.1.0), we prefer not to assume that an unnamed given list is a list of clusterings. \code{cl\_ensemble()} verifies that all given clusterings are of the same kind, and all have the same number of objects. (By the notion of cluster ensembles, we should in principle verify that the clusterings come from the \emph{same} objects, which of course is not always possible.) The list representation makes it possible to use \code{lapply()} for computations on the individual clusterings in (i.e., the components of) a cluster ensemble. Available methods for cluster ensembles include those for subscripting, \code{c()}, \code{rep()}, \code{print()}, and \code{unique()}, where the last is based on a \code{unique()} method for lists added in R~2.1.1, and makes it possible to find unique and duplicated elements in cluster ensembles. The elements of the ensemble can be tabulated using \code{cl\_tabulate()}. Function \code{cl\_boot()} generates cluster ensembles with bootstrap replicates of the results of applying a \dQuote{base} clustering algorithm to a given data set. Currently, this is a rather simple-minded function with limited applicability, and mostly useful for studying the effect of (uncontrolled) random initializations of fixed-point partitioning algorithms such as \code{kmeans()} or \code{cmeans()} in package~\pkg{e1071}. To study the effect of varying control parameters or explicitly providing random starting values, the respective cluster ensemble has to be generated explicitly (most conveniently by using \code{replicate()} to create a list \code{lst} of suitable instances of clusterings obtained by the base algorithm, and using \code{cl\_ensemble(list = lst)} to create the ensemble). Resampling the training data is possible for base algorithms which can predict the class memberships of new data using \code{cl\_predict} (e.g., by classifying the out-of-bag data to their closest prototype). In fact, we believe that for unsupervised learning methods such as clustering, \emph{reweighting} is conceptually superior to resampling, and have therefore recently enhanced package~\pkg{e1071} to provide an implementation of weighted fuzzy $c$-means, and package~\pkg{flexclust} contains an implementation of weighted $k$-means. We are currently experimenting with interfaces for providing ``direct'' support for reweighting via \code{cl\_boot()}. \subsection{Cluster proximities} \subsubsection{Principles} Computing dissimilarities and similarities (``agreements'') between clusterings of the same objects is a key ingredient in the analysis of cluster ensembles. The ``standard'' data structures available for such proximity data (measures of similarity or dissimilarity) are classes~\class{dist} and \class{dissimilarity} in package~\pkg{cluster} (which basically, but not strictly, extends \class{dist}), and are both not entirely suited to our needs. First, they are confined to \emph{symmetric} dissimilarity data. Second, they do not provide enough reflectance. We also note that the Bioconductor package~\pkg{graph}~\citep{cluster:Gentleman+Whalen:2005} contains an efficient subscript method for objects of class~\class{dist}, but returns a ``raw'' matrix for row/column subscripting. For package~\pkg{clue}, we use the following approach. There are classes for symmetric and (possibly) non-symmetric proximity data (\class{cl\_proximity} and \class{cl\_cross\_proximity}), which, in addition to holding the numeric data, also contain a description ``slot'' (attribute), currently a character string, as a first approximation to providing more reflectance. Internally, symmetric proximity data are store the lower diagonal proximity values in a numeric vector (in row-major order), i.e., the same way as objects of class~\class{dist}; a \code{self} attribute can be used for diagonal values (in case some of these are non-zero). Symmetric proximity objects can be coerced to dense matrices using \code{as.matrix()}. It is possible to use 2-index matrix-style subscripting for symmetric proximity objects; unless this uses identical row and column indices, it results in a non-symmetric proximity object. This approach ``propagates'' to classes for symmetric and (possibly) non-symmetric cluster dissimilarity and agreement data (e.g., \class{cl\_dissimilarity} and \class{cl\_cross\_dissimilarity} for dissimilarity data), which extend the respective proximity classes. Ultrametric objects are implemented as symmetric proximity objects with a dissimilarity interpretation so that self-proximities are zero, and inherit from classes~\class{cl\_dissimilarity} and \class{cl\_proximity}. Providing reflectance is far from optimal. For example, if \code{s} is a similarity object (with cluster agreements), \code{1 - s} is a dissimilarity one, but the description is preserved unchanged. This issue could be addressed by providing high-level functions for transforming proximities. \label{synopsis} Cluster dissimilarities are computed via \code{cl\_dissimilarity()} with synopsis \code{cl\_dissimilarity(x, y = NULL, method = "euclidean")}, where \code{x} and \code{y} are cluster ensemble objects or coercible to such, or \code{NULL} (\code{y} only). If \code{y} is \code{NULL}, the return value is an object of class~\class{cl\_dissimilarity} which contains the dissimilarities between all pairs of clusterings in \code{x}. Otherwise, it is an object of class~\class{cl\_cross\_dissimilarity} with the dissimilarities between the clusterings in \code{x} and the clusterings in \code{y}. Formal argument \code{method} is either a character string specifying one of the built-in methods for computing dissimilarity, or a function to be taken as a user-defined method, making it reasonably straightforward to add methods. Function \code{cl\_agreement()} has the same interface as \code{cl\_dissimilarity()}, returning cluster similarity objects with respective classes~\class{cl\_agreement} and \class{cl\_cross\_agreement}. Built-in methods for computing dissimilarities may coincide (in which case they are transforms of each other), but do not necessarily do so, as there typically are no canonical transformations. E.g., according to needs and scientific community, agreements might be transformed to dissimilarities via $d = - \log(s)$ or the square root thereof \citep[e.g.,][]{cluster:Strehl+Ghosh:2003b}, or via $d = 1 - s$. \subsubsection{Partition proximities} When assessing agreement or dissimilarity of partitions, one needs to consider that the class ids may be permuted arbitrarily without changing the underlying partitions. For membership matrices~$M$, permuting class ids amounts to replacing $M$ by $M \Pi$, where $\Pi$ is a suitable permutation matrix. We note that the co-membership matrix $C(M) = MM'$ is unchanged by these transformations; hence, proximity measures based on co-occurrences, such as the Katz-Powell \citep{cluster:Katz+Powell:1953} or Rand \citep{cluster:Rand:1971} indices, do not explicitly need to adjust for possible re-labeling. The same is true for measures based on the ``confusion matrix'' $M' \tilde{M}$ of two membership matrices $M$ and $\tilde{M}$ which are invariant under permutations of rows and columns, such as the Normalized Mutual Information (NMI) measure introduced in \cite{cluster:Strehl+Ghosh:2003a}. Other proximity measures need to find permutations so that the classes are optimally matched, which of course in general requires exhaustive search through all $k!$ possible permutations, where $k$ is the (common) number of classes in the partitions, and thus will typically be prohibitively expensive. Fortunately, in some important cases, optimal matchings can be determined very efficiently. We explain this in detail for ``Euclidean'' partition dissimilarity and agreement (which in fact is the default measure used by \code{cl\_dissimilarity()} and \code{cl\_agreement()}). Euclidean partition dissimilarity \citep{cluster:Dimitriadou+Weingessel+Hornik:2002} is defined as \begin{displaymath} d(M, \tilde{M}) = \min\nolimits_\Pi \| M - \tilde{M} \Pi \| \end{displaymath} where the minimum is taken over all permutation matrices~$\Pi$, $\|\cdot\|$ is the Frobenius norm (so that $\|Y\|^2 = \trace(Y'Y)$), and $n$ is the (common) number of objects in the partitions. As $\| M - \tilde{M} \Pi \|^2 = \trace(M'M) - 2 \trace(M'\tilde{M}\Pi) + \trace(\Pi'\tilde{M}'\tilde{M}\Pi) = \trace(M'M) - 2 \trace(M'\tilde{M}\Pi) + \trace(\tilde{M}'\tilde{M})$, we see that minimizing $\| M - \tilde{M} \Pi \|^2$ is equivalent to maximizing $\trace(M'\tilde{M}\Pi) = \sum_{i,k}{\mu_{ik}\tilde{\mu}}_{i,\pi(k)}$, which for hard partitions is the number of objects with the same label in the partitions given by $M$ and $\tilde{M}\Pi$. Finding the optimal $\Pi$ is thus recognized as an instance of the \emph{linear sum assignment problem} (LSAP, also known as the weighted bipartite graph matching problem). The LSAP can be solved by linear programming, e.g., using Simplex-style primal algorithms as done by function~\code{lp.assign()} in package~\pkg{lpSolve}~\citep{cluster:Buttrey:2005}, but primal-dual algorithms such as the so-called Hungarian method can be shown to find the optimum in time $O(k^3)$ \citep[e.g.,][]{cluster:Papadimitriou+Steiglitz:1982}. Available published implementations include TOMS 548 \citep{cluster:Carpaneto+Toth:1980}, which however is restricted to integer weights and $k < 131$. One can also transform the LSAP into a network flow problem, and use e.g.~RELAX-IV \citep{cluster:Bertsekas+Tseng:1994} for solving this, as is done in package~\pkg{optmatch}~\citep{cluster:Hansen:2005}. In package~\pkg{clue}, we use an efficient C implementation of the Hungarian algorithm kindly provided to us by Walter B\"ohm, which has been found to perform very well across a wide range of problem sizes. \cite{cluster:Gordon+Vichi:2001} use a variant of Euclidean dissimilarity (``GV1 dissimilarity'') which is based on the sum of the squared difference of the memberships of matched (non-empty) classes only, discarding the unmatched ones (see their Example~2). This results in a measure which is discontinuous over the space of soft partitions with arbitrary numbers of classes. The partition agreement measures ``angle'' and ``diag'' (maximal cosine of angle between the memberships, and maximal co-classification rate, where both maxima are taken over all column permutations of the membership matrices) are based on solving the same LSAP as for Euclidean dissimilarity. Finally, Manhattan partition dissimilarity is defined as the minimal sum of the absolute differences of $M$ and all column permutations of $\tilde{M}$, and can again be computed efficiently by solving an LSAP. For hard partitions, both Manhattan and squared Euclidean dissimilarity give twice the \emph{transfer distance} \citep{cluster:Charon+Denoeud+Guenoche:2006}, which is the minimum number of objects that must be removed so that the implied partitions (restrictions to the remaining objects) are identical. This is also known as the \emph{$R$-metric} in \cite{cluster:Day:1981}, i.e., the number of augmentations and removals of single objects needed to transform one partition into the other, and the \emph{partition-distance} in \cite{cluster:Gusfield:2002}. Note when assessing proximity that agreements for soft partitions are always (and quite often considerably) lower than the agreements for the corresponding nearest hard partitions, unless the agreement measures are based on the latter anyways (as currently done for Rand, Katz-Powell, and NMI). Package~\pkg{clue} provides additional agreement measures, such as the Jaccard and Fowles-Mallows \citep[quite often incorrectly attributed to \cite{cluster:Wallace:1983}]{cluster:Fowlkes+Mallows:1983a} indices, and dissimilarity measures such as the ``symdiff'' and Rand distances (the latter is proportional to the metric of \cite{cluster:Mirkin:1996}) and the metrics discussed in \cite{cluster:Boorman+Arabie:1972}. One could easily add more proximity measures, such as the ``Variation of Information'' \citep{cluster:Meila:2003}. However, all these measures are rigorously defined for hard partitions only. To see why extensions to soft partitions are far from straightforward, consider e.g.\ measures based on the confusion matrix. Its entries count the cardinality of certain intersections of sets. \label{fuzzy} In a fuzzy context for soft partitions, a natural generalization would be using fuzzy cardinalities (i.e., sums of memberships values) of fuzzy intersections instead. There are many possible choices for the latter, with the product of the membership values (corresponding to employing the confusion matrix also in the fuzzy case) one of them, but the minimum instead of the product being the ``usual'' choice. A similar point can be made for co-occurrences of soft memberships. We are not aware of systematic investigations of these extension issues. \subsubsection{Hierarchy proximities} Available built-in dissimilarity measures for hierarchies include \emph{Euclidean} (again, the default measure used by \code{cl\_dissimilarity()}) and Manhattan dissimilarity, which are simply the Euclidean (square root of the sum of squared differences) and Manhattan (sum of the absolute differences) dissimilarities between the associated ultrametrics. Cophenetic dissimilarity is defined as $1 - c^2$, where $c$ is the cophenetic correlation coefficient \citep{cluster:Sokal+Rohlf:1962}, i.e., the Pearson product-moment correlation between the ultrametrics. Gamma dissimilarity is the rate of inversions between the associated ultrametrics $u$ and $v$ (i.e., the rate of pairs $(i,j)$ and $(k,l)$ for which $u_{ij} < u_{kl}$ and $v_{ij} > v_{kl}$). This measure is a linear transformation of Kruskal's~$\gamma$. Finally, symdiff dissimilarity is the cardinality of the symmetric set difference of the sets of classes (hierarchies in the strict sense) induced by the dendrograms. Associated agreement measures are obtained by suitable transformations of the dissimilarities~$d$; for Euclidean proximities, we prefer to use $1 / (1 + d)$ rather than e.g.\ $\exp(-d)$. One should note that whereas cophenetic and gamma dissimilarities are invariant to linear transformations, Euclidean and Manhattan ones are not. Hence, if only the relative ``structure'' of the dendrograms is of interest, these dissimilarities should only be used after transforming the ultrametrics to a common range of values (e.g., to $[0,1]$). \subsection{Consensus clusterings} Consensus clusterings ``synthesize'' the information in the elements of a cluster ensemble into a single clustering. There are three main approaches to obtaining consensus clusterings \citep{cluster:Hornik:2005a,cluster:Gordon+Vichi:2001}: in the \emph{constructive} approach, one specifies a way to construct a consensus clustering. In the \emph{axiomatic} approach, emphasis is on the investigation of existence and uniqueness of consensus clusterings characterized axiomatically. The \emph{optimization} approach formalizes the natural idea of describing consensus clusterings as the ones which ``optimally represent the ensemble'' by providing a criterion to be optimized over a suitable set $\mathcal{C}$ of possible consensus clusterings. If $d$ is a dissimilarity measure and $C_1, \ldots, C_B$ are the elements of the ensemble, one can e.g.\ look for solutions of the problem \begin{displaymath} \sum\nolimits_{b=1}^B w_b d(C, C_b) ^ p \Rightarrow \min\nolimits_{C \in \mathcal{C}}, \end{displaymath} for some $p \ge 0$, i.e., as clusterings~$C^*$ minimizing weighted average dissimilarity powers of order~$p$. Analogously, if a similarity measure is given, one can look for clusterings maximizing weighted average similarity powers. Following \cite{cluster:Gordon+Vichi:1998}, an above $C^*$ is referred to as (weighted) \emph{median} or \emph{medoid} clustering if $p = 1$ and the optimum is sought over the set of all possible base clusterings, or the set $\{ C_1, \ldots, C_B \}$ of the base clusterings, respectively. For $p = 2$, we have \emph{least squares} consensus clusterings (generalized means). For computing consensus clusterings, package~\pkg{clue} provides function \code{cl\_consensus()} with synopsis \code{cl\_consensus(x, method = NULL, weights = 1, control = list())}. This allows (similar to the functions for computing cluster proximities, see Section~\ref{synopsis} on Page~\pageref{synopsis}) argument \code{method} to be a character string specifying one of the built-in methods discussed below, or a function to be taken as a user-defined method (taking an ensemble, the case weights, and a list of control parameters as its arguments), again making it reasonably straightforward to add methods. In addition, function~\code{cl\_medoid()} can be used for obtaining medoid partitions (using, in principle, arbitrary dissimilarities). Modulo possible differences in the case of ties, this gives the same results as (the medoid obtained by) \code{pam()} in package~\pkg{cluster}. If all elements of the ensemble are partitions, package~\pkg{clue} provides algorithms for computing soft least squares consensus partitions for weighted Euclidean, GV1 and co-membership dissimilarities. Let $M_1, \ldots, M_B$ and $M$ denote the membership matrices of the elements of the ensemble and their sought least squares consensus partition, respectively. For Euclidean dissimilarity, we need to find \begin{displaymath} \sum_b w_b \min\nolimits_{\Pi_b} \| M - M_b \Pi_b \|^2 \Rightarrow \min\nolimits_M \end{displaymath} over all membership matrices (i.e., stochastic matrices) $M$, or equivalently, \begin{displaymath} \sum_b w_b \| M - M_b \Pi_b \|^2 \Rightarrow \min\nolimits_{M, \Pi_1, \ldots, \Pi_B} \end{displaymath} over all $M$ and permutation matrices $\Pi_1, \ldots, \Pi_B$. Now fix the $\Pi_b$ and let $\bar{M} = s^{-1} \sum_b w_b M_b \Pi_b$ be the weighted average of the $M_b \Pi_b$, where $s = \sum_b w_b$. Then \begin{eqnarray*} \lefteqn{\sum_b w_b \| M - M_b \Pi_b \|^2} \\ &=& \sum_b w_b (\|M\|^2 - 2 \trace(M' M_b \Pi_b) + \|M_b\Pi_b\|^2) \\ &=& s \|M\|^2 - 2 s \trace(M' \bar{M}) + \sum_b w_b \|M_b\|^2 \\ &=& s (\|M - \bar{M}\|^2) + \sum_b w_b \|M_b\|^2 - s \|\bar{M}\|^2 \end{eqnarray*} Thus, as already observed in \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} and \cite{cluster:Gordon+Vichi:2001}, for fixed permutations $\Pi_b$ the optimal soft $M$ is given by $\bar{M}$. The optimal permutations can be found by minimizing $- s \|\bar{M}\|^2$, or equivalently, by maximizing \begin{displaymath} s^2 \|\bar{M}\|^2 = \sum_{\beta, b} w_\beta w_b \trace(\Pi_\beta'M_\beta'M_b\Pi_b). \end{displaymath} With $U_{\beta,b} = w_\beta w_b M_\beta' M_b$ we can rewrite the above as \begin{displaymath} \sum_{\beta, b} w_\beta w_b \trace(\Pi_\beta'M_\beta'M_b\Pi_b) = \sum_{\beta,b} \sum_{j=1}^k [U_{\beta,b}]_{\pi_\beta(j), \pi_b(j)} =: \sum_{j=1}^k c_{\pi_1(j), \ldots, \pi_B(j)} \end{displaymath} This is an instance of the \emph{multi-dimensional assignment problem} (MAP), which, contrary to the LSAP, is known to be NP-hard \citep[e.g., via reduction to 3-DIMENSIONAL MATCHING,][]{cluster:Garey+Johnson:1979}, and can e.g.\ be approached using randomized parallel algorithms \citep{cluster:Oliveira+Pardalos:2004}. Branch-and-bound approaches suggested in the literature \citep[e.g.,][]{cluster:Grundel+Oliveira+Pardalos:2005} are unfortunately computationally infeasible for ``typical'' sizes of cluster ensembles ($B \ge 20$, maybe even in the hundreds). Package~\pkg{clue} provides two heuristics for (approximately) finding the soft least squares consensus partition for Euclidean dissimilarity. Method \code{"DWH"} of function \code{cl\_consensus()} is an extension of the greedy algorithm in \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} which is based on a single forward pass through the ensemble which in each step chooses the ``locally'' optimal $\Pi$. Starting with $\tilde{M}_1 = M_1$, $\tilde{M}_b$ is obtained from $\tilde{M}_{b-1}$ by optimally matching $M_b \Pi_b$ to this, and taking a weighted average of $\tilde{M}_{b-1}$ and $M_b \Pi_b$ in a way that $\tilde{M}_b$ is the weighted average of the first~$b$ $M_\beta \Pi_\beta$. This simple approach could be further enhanced via back-fitting or several passes, in essence resulting in an ``on-line'' version of method \code{"SE"}. This, in turn, is a fixed-point algorithm, which iterates between updating $M$ as the weighted average of the current $M_b \Pi_b$, and determining the $\Pi_b$ by optimally matching the current $M$ to the individual $M_b$. Finally, method \code{"GV1"} implements the fixed-point algorithm for the ``first model'' in \cite{cluster:Gordon+Vichi:2001}, which gives least squares consensus partitions for GV1 dissimilarity. In the above, we implicitly assumed that all partitions in the ensemble as well as the sought consensus partition have the same number of classes. The more general case can be dealt with through suitable ``projection'' devices. When using co-membership dissimilarity, the least squares consensus partition is determined by minimizing \begin{eqnarray*} \lefteqn{\sum_b w_b \|MM' - M_bM_b'\|^2} \\ &=& s \|MM' - \bar{C}\|^2 + \sum_b w_b \|M_bM_b'\|^2 - s \|\bar{C}\|^2 \end{eqnarray*} over all membership matrices~$M$, where now $\bar{C} = s^{-1} \sum_b C(M_b) = s^{-1} \sum_b M_bM_b'$ is the weighted average co-membership matrix of the ensemble. This corresponds to the ``third model'' in \cite{cluster:Gordon+Vichi:2001}. Method \code{"GV3"} of function \code{cl\_consensus()} provides a SUMT approach (see Section~\ref{SUMT} on Page~\pageref{SUMT}) for finding the minimum. We note that this strategy could more generally be applied to consensus problems of the form \begin{displaymath} \sum_b w_b \|\Phi(M) - \Phi(M_b)\|^2 \Rightarrow \min\nolimits_M, \end{displaymath} which are equivalent to minimizing $\|\Phi(B) - \bar{\Phi}\|^2$, with $\bar{\Phi}$ the weighted average of the $\Phi(M_b)$. This includes e.g.\ the case where generalized co-memberships are defined by taking the ``standard'' fuzzy intersection of co-incidences, as discussed in Section~\ref{fuzzy} on Page~\pageref{fuzzy}. Package~\pkg{clue} currently does not provide algorithms for obtaining \emph{hard} consensus partitions, as e.g.\ done in \cite{cluster:Krieger+Green:1999} using Rand proximity. It seems ``natural'' to extend the methods discussed above to include a constraint on softness, e.g., on the partition coefficient PC (see Section~\ref{PC} on Page~\pageref{PC}). For Euclidean dissimilarity, straightforward Lagrangian computations show that the constrained minima are of the form $\bar{M}(\alpha) = \alpha \bar{M} + (1 - \alpha) E$, where $E$ is the ``maximally soft'' membership with all entries equal to $1/k$, $\bar{M}$ is again the weighted average of the $M_b\Pi_b$ with the $\Pi_b$ solving the underlying MAP, and $\alpha$ is chosen such that $PC(\bar{M}(\alpha))$ equals a prescribed value. As $\alpha$ increases (even beyond one), softness of the $\bar{M}(\alpha)$ decreases. However, for $\alpha^* > 1 / (1 - k\mu^*)$, where $\mu^*$ is the minimum of the entries of $\bar{M}$, the $\bar{M}(\alpha)$ have negative entries, and are no longer feasible membership matrices. Obviously, the non-negativity constraints for the $\bar{M}(\alpha)$ eventually put restrictions on the admissible $\Pi_b$ in the underlying MAP. Thus, such a simple relaxation approach to obtaining optimal hard partitions is not feasible. For ensembles of hierarchies, \code{cl\_consensus()} provides a built-in method (\code{"cophenetic"}) for approximately minimizing average weighted squared Euclidean dissimilarity \begin{displaymath} \sum_b w_b \| U - U_b \|^2 \Rightarrow \min\nolimits_U \end{displaymath} over all ultrametrics~$U$, where $U_1, \ldots, U_B$ are the ultrametrics corresponding to the elements of the ensemble. This is of course equivalent to minimizing $\| U - \bar{U} \|^2$, where $\bar{U} = s^{-1} \sum_b w_b U_b$ is the weighted average of the $U_b$. The SUMT approach provided by function \code{ls\_fit\_ultrametric()} (see Section~\ref{SUMT} on Page~\pageref{SUMT}) is employed for finding the sought weighted least squares consensus hierarchy. In addition, method \code{"majority"} obtains a consensus hierarchy from an extension of the majority consensus tree of \cite{cluster:Margush+McMorris:1981}, which minimizes $L(U) = \sum_b w_b d(U_b, U)$ over all ultrametrics~$U$, where $d$ is the symmetric difference dissimilarity. Clearly, the available methods use heuristics for solving hard optimization problems, and cannot be guaranteed to find a global optimum. Standard practice would recommend to use the best solution found in ``sufficiently many'' replications of the methods. Alternative recent approaches to obtaining consensus partitions include ``Bagged Clustering'' \citep[provided by \code{bclust()} in package~\pkg{e1071}]{cluster:Leisch:1999}, the ``evidence accumulation'' framework of \cite{cluster:Fred+Jain:2002}, the NMI optimization and graph-partitioning methods in \cite{cluster:Strehl+Ghosh:2003a}, ``Bagged Clustering'' as in \cite{cluster:Dudoit+Fridlyand:2003}, and the hybrid bipartite graph formulation of \cite{cluster:Fern+Brodley:2004}. Typically, these approaches are constructive, and can easily be implemented based on the infrastructure provided by package~\pkg{clue}. Evidence accumulation amounts to standard hierarchical clustering of the average co-membership matrix. Procedure~BagClust1 of \cite{cluster:Dudoit+Fridlyand:2003} amounts to computing $B^{-1} \sum_b M_b\Pi_b$, where each $\Pi_b$ is determined by optimal Euclidean matching of $M_b$ to a fixed reference membership $M_0$. In the corresponding ``Bagged Clustering'' framework, $M_0$ and the $M_b$ are obtained by applying the base clusterer to the original data set and bootstrap samples from it, respectively. This is implemented as method \code{"DFBC1"} of \code{cl\_bag()} in package~\pkg{clue}. Finally, the approach of \cite{cluster:Fern+Brodley:2004} solves an LSAP for an asymmetric cost matrix based on object-by-all-classes incidences. \subsection{Cluster partitions} To investigate the ``structure'' in a cluster ensemble, an obvious idea is to start clustering the clusterings in the ensemble, resulting in ``secondary'' clusterings \citep{cluster:Gordon+Vichi:1998, cluster:Gordon:1999}. This can e.g.\ be performed by using \code{cl\_dissimilarity()} (or \code{cl\_agreement()}) to compute a dissimilarity matrix for the ensemble, and feed this into a dissimilarity-based clustering algorithm (such as \code{pam()} in package~\pkg{cluster} or \code{hclust()} in package~\pkg{stats}). (One can even use \code{cutree()} to obtain hard partitions from hierarchies thus obtained.) If prototypes (``typical clusterings'') are desired for partitions of clusterings, they can be determined post-hoc by finding suitable consensus clusterings in the classes of the partition, e.g., using \code{cl\_consensus()} or \code{cl\_medoid()}. Package~\pkg{clue} additionally provides \code{cl\_pclust()} for direct prototype-based partitioning based on minimizing criterion functions of the form $\sum w_b u_{bj}^m d(x_b, p_j)^e$, the sum of the case-weighted membership-weighted $e$-th powers of the dissimilarities between the elements~$x_b$ of the ensemble and the prototypes~$p_j$, for suitable dissimilarities~$d$ and exponents~$e$. (The underlying feature spaces are that of membership matrices and ultrametrics, respectively, for partitions and hierarchies.) Parameter~$m$ must not be less than one and controls the softness of the obtained partitions, corresponding to the \dQuote{fuzzification parameter} of the fuzzy $c$-means algorithm. For $m = 1$, a generalization of the Lloyd-Forgy variant \citep{cluster:Lloyd:1957, cluster:Forgy:1965, cluster:Lloyd:1982} of the $k$-means algorithm is used, which iterates between reclassifying objects to their closest prototypes, and computing new prototypes as consensus clusterings for the classes. \citet{cluster:Gaul+Schader:1988} introduced this procedure for \dQuote{Clusterwise Aggregation of Relations} (with the same domains), containing equivalence relations, i.e., hard partitions, as a special case. For $m > 1$, a generalization of the fuzzy $c$-means recipe \citep[e.g.,][]{cluster:Bezdek:1981} is used, which alternates between computing optimal memberships for fixed prototypes, and computing new prototypes as the suitably weighted consensus clusterings for the classes. This procedure is repeated until convergence occurs, or the maximal number of iterations is reached. Consensus clusterings are computed using (one of the methods provided by) \code{cl\_consensus}, with dissimilarities~$d$ and exponent~$e$ implied by method employed, and obtained via a registration mechanism. The default methods compute Least Squares Euclidean consensus clusterings, i.e., use Euclidean dissimilarity~$d$ and $e = 2$. \section{Examples} \label{sec:examples} \subsection{Cassini data} \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} and \cite{cluster:Leisch:1999} use Cassini data sets to illustrate how e.g.\ suitable aggregation of base $k$-means results can reveal underlying non-convex structure which cannot be found by the base algorithm. Such data sets contain points in 2-dimensional space drawn from the uniform distribution on 3 structures, with the two ``outer'' ones banana-shaped and the ``middle'' one a circle, and can be obtained by function~\code{mlbench.cassini()} in package~\pkg{mlbench}~\citep{cluster:Leisch+Dimitriadou:2005}. Package~\pkg{clue} contains the data sets \code{Cassini} and \code{CKME}, which are an instance of a 1000-point Cassini data set, and a cluster ensemble of 50 $k$-means partitions of the data set into three classes, respectively. The data set is shown in Figure~\ref{fig:Cassini}. <>= data("Cassini") plot(Cassini$x, col = as.integer(Cassini$classes), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{The Cassini data set.} \label{fig:Cassini} \end{figure} Figure~\ref{fig:CKME} gives a dendrogram of the Euclidean dissimilarities of the elements of the $k$-means ensemble. <>= data("CKME") plot(hclust(cl_dissimilarity(CKME)), labels = FALSE) @ % \begin{figure} \centering <>= <> @ % \caption{A dendrogram of the Euclidean dissimilarities of 50 $k$-means partitions of the Cassini data into 3 classes.} \label{fig:CKME} \end{figure} We can see that there are large groups of essentially identical $k$-means solutions. We can gain more insight by inspecting representatives of these three groups, or by computing the medoid of the ensemble <<>>= m1 <- cl_medoid(CKME) table(Medoid = cl_class_ids(m1), "True Classes" = Cassini$classes) @ % $ and inspecting it (Figure~\ref{fig:Cassini-medoid}): <>= plot(Cassini$x, col = cl_class_ids(m1), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{Medoid of the Cassini $k$-means ensemble.} \label{fig:Cassini-medoid} \end{figure} Flipping this solution top-down gives a second ``typical'' partition. We see that the $k$-means base clusterers cannot resolve the underlying non-convex structure. For the least squares consensus of the ensemble, we obtain <<>>= set.seed(1234) m2 <- cl_consensus(CKME) @ % where here and below we set the random seed for reproducibility, noting that one should really use several replicates of the consensus heuristic. This consensus partition has confusion matrix <<>>= table(Consensus = cl_class_ids(m2), "True Classes" = Cassini$classes) @ % $ and class details as displayed in Figure~\ref{fig:Cassini-mean}: <>= plot(Cassini$x, col = cl_class_ids(m2), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{Least Squares Consensus of the Cassini $k$-means ensemble.} \label{fig:Cassini-mean} \end{figure} This has drastically improved performance, and almost perfect recovery of the two outer shapes. In fact, \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} show that almost perfect classification can be obtained by suitable combinations of different base clusterers ($k$-means, fuzzy $c$-means, and unsupervised fuzzy competitive learning). \subsection{Gordon-Vichi macroeconomic data} \citet[Table~1]{cluster:Gordon+Vichi:2001} provide soft partitions of 21 countries based on macroeconomic data for the years 1975, 1980, 1985, 1990, and 1995. These partitions were obtained using fuzzy $c$-means on measurements of the following variables: the annual per capita gross domestic product (GDP) in USD (converted to 1987 prices); the percentage of GDP provided by agriculture; the percentage of employees who worked in agriculture; and gross domestic investment, expressed as a percentage of the GDP. Table~5 in \cite{cluster:Gordon+Vichi:2001} gives 3-class consensus partitions obtained by applying their models 1, 2, and 3 and the approach in \cite{cluster:Sato+Sato:1994}. The partitions and consensus partitions are available in data sets \code{GVME} and \code{GVME\_Consensus}, respectively. We compare the results of \cite{cluster:Gordon+Vichi:2001} using GV1 dissimilarities (model 1) to ours as obtained by \code{cl\_consensus()} with method \code{"GV1"}. <<>>= data("GVME") GVME set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 3, verbose = TRUE)) @ % This results in a soft partition with average squared GV1 dissimilarity (the criterion function to be optimized by the consensus partition) of <<>>= mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) @ % We compare this to the consensus solution given in \cite{cluster:Gordon+Vichi:2001}: <<>>= data("GVME_Consensus") m2 <- GVME_Consensus[["MF1/3"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) @ % Interestingly, we are able to obtain a ``better'' solution, which however agrees with the one reported on the literature with respect to their nearest hard partitions. For the 2-class consensus partition, we obtain <<>>= set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) @ which is slightly better than the solution reported in \cite{cluster:Gordon+Vichi:2001} <<>>= mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) m2 <- GVME_Consensus[["MF1/2"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) @ but in fact agrees with it apart from rounding errors: <<>>= max(abs(cl_membership(m1) - cl_membership(m2))) @ It is interesting to compare these solutions to the Euclidean 2-class consensus partition for the GVME ensemble: <<>>= m3 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) @ This is markedly different from the GV1 consensus partition <<>>= table(GV1 = cl_class_ids(m1), Euclidean = cl_class_ids(m3)) @ with countries <<>>= rownames(m1)[cl_class_ids(m1) != cl_class_ids(m3)] @ % classified differently, being with the ``richer'' class for the GV1 and the ``poorer'' for the Euclidean consensus partition. (In fact, all these countries end up in the ``middle'' class for the 3-class GV1 consensus partition.) \subsection{Rosenberg-Kim kinship terms data} \cite{cluster:Rosenberg+Kim:1975} describe an experiment where perceived similarities of the kinship terms were obtained from six different ``sorting'' experiments. In one of these, 85 female undergraduates at Rutgers University were asked to sort 15 English terms into classes ``on the basis of some aspect of meaning''. These partitions were printed in \citet[Table~7.1]{cluster:Rosenberg:1982}. Comparison with the original data indicates that the partition data have the ``nephew'' and ``niece'' columns interchanged, which is corrected in data set \code{Kinship82}. \citet[Table~6]{cluster:Gordon+Vichi:2001} provide consensus partitions for these data based on their models 1--3 (available in data set \code{Kinship82\_Consensus}). We compare their results using co-membership dissimilarities (model 3) to ours as obtained by \code{cl\_consensus()} with method \code{"GV3"}. <<>>= data("Kinship82") Kinship82 set.seed(1) m1 <- cl_consensus(Kinship82, method = "GV3", control = list(k = 3, verbose = TRUE)) @ % This results in a soft partition with average co-membership dissimilarity (the criterion function to be optimized by the consensus partition) of <<>>= mean(cl_dissimilarity(Kinship82, m1, "comem") ^ 2) @ % Again, we compare this to the corresponding consensus solution given in \cite{cluster:Gordon+Vichi:2001}: <<>>= data("Kinship82_Consensus") m2 <- Kinship82_Consensus[["JMF"]] mean(cl_dissimilarity(Kinship82, m2, "comem") ^ 2) @ % Interestingly, again we obtain a (this time only ``slightly'') better solution, with <<>>= cl_dissimilarity(m1, m2, "comem") table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) @ % indicating that the two solutions are reasonably close, even though <<>>= cl_fuzziness(cl_ensemble(m1, m2)) @ % shows that the solution found by \pkg{clue} is ``softer''. \subsection{Miller-Nicely consonant phoneme confusion data} \cite{cluster:Miller+Nicely:1955} obtained the data on the auditory confusions of 16 English consonant phonemes by exposing female subjects to a series of syllables consisting of one of the consonants followed by the vowel `a' under 17 different experimental conditions. Data set \code{Phonemes} provides consonant misclassification probabilities (i.e., similarities) obtained from aggregating the six so-called flat-noise conditions in which only the speech-to-noise ratio was varied into a single matrix of misclassification frequencies. These data are used in \cite{cluster:DeSoete:1986} as an illustration of the SUMT approach for finding least squares optimal fits to dissimilarities by ultrametrics. We can reproduce this analysis as follows. <<>>= data("Phonemes") d <- as.dist(1 - Phonemes) @ % (Note that the data set has the consonant misclassification probabilities, i.e., the similarities between the phonemes.) <<>>= u <- ls_fit_ultrametric(d, control = list(verbose = TRUE)) @ % This gives an ultrametric~$u$ for which Figure~\ref{fig:Phonemes} plots the corresponding dendrogram, ``basically'' reproducing Figure~1 in \cite{cluster:DeSoete:1986}. <>= plot(u) @ % \begin{figure} \centering <>= <> @ % \caption{Dendrogram for least squares fit to the Miller-Nicely consonant phoneme confusion data.} \label{fig:Phonemes} \end{figure} We can also compare the least squares fit obtained to that of other hierarchical clusterings of $d$, e.g.\ those obtained by \code{hclust()}. The ``optimal''~$u$ has Euclidean dissimilarity <<>>= round(cl_dissimilarity(d, u), 4) @ % to $d$. For the \code{hclust()} results, we get <<>>= hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hens <- cl_ensemble(list = lapply(hclust_methods, function(m) hclust(d, m))) names(hens) <- hclust_methods round(sapply(hens, cl_dissimilarity, d), 4) @ % which all exhibit greater Euclidean dissimilarity to $d$ than $u$. (We exclude methods \code{"median"} and \code{"centroid"} as these do not yield valid hierarchies.) We can also compare the ``structure'' of the different hierarchies, e.g.\ by looking at the rate of inversions between them: <<>>= ahens <- c(L2opt = cl_ensemble(u), hens) round(cl_dissimilarity(ahens, method = "gamma"), 2) @ % \section{Outlook} \label{sec:outlook} Package~\pkg{clue} was designed as an \emph{extensible} environment for computing on cluster ensembles. It currently provides basic data structures for representing partitions and hierarchies, and facilities for computing on these, including methods for measuring proximity and obtaining consensus and ``secondary'' clusterings. Many extensions to the available functionality are possible and in fact planned (some of these enhancements were already discussed in more detail in the course of this paper). \begin{itemize} \item Provide mechanisms to generate cluster ensembles based on reweighting (assuming base clusterers allowing for case weights) the data set. \item Explore recent advances (e.g., parallelized random search) in heuristics for solving the multi-dimensional assignment problem. \item Add support for \emph{additive trees} \citep[e.g.,][]{cluster:Barthelemy+Guenoche:1991}. \item Add heuristics for finding least squares fits based on iterative projection on convex sets of constraints, see e.g.\ \cite{cluster:Hubert+Arabie+Meulman:2006} and the accompanying MATLAB code available at \url{http://cda.psych.uiuc.edu/srpm_mfiles} for using these methods (instead of SUMT approaches) to fit ultrametrics and additive trees to proximity data. \item Add an ``$L_1$ View''. Emphasis in \pkg{clue}, in particular for obtaining consensus clusterings, is on using Euclidean dissimilarities (based on suitable least squares distances); arguably, more ``robust'' consensus solutions should result from using Manhattan dissimilarities (based on absolute distances). Adding such functionality necessitates developing the corresponding structure theory for soft Manhattan median partitions. Minimizing average Manhattan dissimilarity between co-memberships and ultrametrics results in constrained $L_1$ approximation problems for the weighted medians of the co-memberships and ultrametrics, respectively, and could be approached by employing SUMTs analogous to the ones used for the $L_2$ approximations. \item Provide heuristics for obtaining \emph{hard} consensus partitions. \item Add facilities for tuning hyper-parameters (most prominently, the number of classes employed) and ``cluster validation'' of partitioning algorithms, as recently proposed by \cite{cluster:Roth+Lange+Braun:2002}, \cite{cluster:Lange+Roth+Braun:2004}, \cite{cluster:Dudoit+Fridlyand:2002}, and \cite{cluster:Tibshirani+Walther:2005}. \end{itemize} We are hoping to be able to provide many of these extensions in the near future. \subsubsection*{Acknowledgments} We are grateful to Walter B\"ohm for providing efficient C code for solving assignment problems. {\small \bibliographystyle{abbrvnat} \bibliography{cluster} } \end{document} clue/R/0000755000175100001440000000000014503541710011421 5ustar hornikusersclue/R/classes.R0000644000175100001440000000460613434542602013212 0ustar hornikuserscl_classes <- function(x) UseMethod("cl_classes") cl_classes.default <- function(x) { ## Be nice to users ... if(is.cl_partition(x)) cl_classes(as.cl_partition(x)) else if(is.cl_dendrogram(x)) cl_classes(as.cl_dendrogram(x)) else stop("Can only determine classes of partitions or hierarchies.") } cl_classes.cl_partition <- function(x) { n <- n_of_objects(x) out <- split(seq_len(n), cl_class_ids(x)) class(out) <- c("cl_classes_of_partition_of_objects", "cl_classes_of_objects") attr(out, "n_of_objects") <- n attr(out, "labels") <- cl_object_labels(x) out } cl_classes.cl_hierarchy <- function(x) { ## Assume a valid hierarchy/dendrogram. x <- as.hclust(x) n <- n_of_objects(x) labels <- seq_len(n) ## Only use the "maximal" partitions for each height (relevant in ## case of non-binary trees). groups <- cutree(x, h = unique(c(0, x$height))) ## Give a list with the (unique) sets of numbers of the objects. ## Note that objects may already be merged at height zero. out <- unique(unlist(c(as.list(labels), lapply(split(groups, col(groups)), function(k) split(labels, k))), recursive = FALSE, use.names = FALSE)) ## Preserve labels if possible, and re-order according to ## cardinality. out <- out[order(lengths(out))] class(out) <- c("cl_classes_of_hierarchy_of_objects", "cl_classes_of_objects") attr(out, "n_of_objects") <- n attr(out, "labels") <- cl_object_labels(x) out } ## Be nice to users of ultrametric fitters ... which should really fit ## dendrograms (which inherit from hierarchies). cl_classes.cl_ultrametric <- cl_classes.cl_hierarchy print.cl_classes_of_partition_of_objects <- function(x, ...) { labels <- attr(x, "labels") y <- lapply(x, function(i) paste(labels[i], collapse = ", ")) writeLines(formatDL(names(x), sprintf("{%s}", unlist(y)), style = "list", ...)) invisible(x) } print.cl_classes_of_hierarchy_of_objects <- function(x, ...) { labels <- attr(x, "labels") y <- lapply(x, function(i) paste(labels[i], collapse = ", ")) y <- strwrap(sprintf("{%s},", unlist(y)), exdent = 2) y[length(y)] <- sub(",$", "", y[length(y)]) writeLines(y) invisible(x) } clue/R/pclust.R0000644000175100001440000004307013036513600013057 0ustar hornikusers### * cl_pclust cl_pclust <- function(x, k, method = NULL, m = 1, weights = 1, control = list()) { ## Partition a cluster ensemble x into (at most) k classes by ## minimizing ## \sum_b \sum_j w_b u_{bj}^m d(x_b, p_j) ^ e ## for "suitable" prototypes p_1, ..., p_k, where 1 <= m < \infty, ## with 1 corresponding to hard (secondary) partitions, and d a ## dissimilarity measure (such as Euclidean dissimilarity of ## partitions or hierarchies). ## ## The algorithm works whenever there is a consensus method for ## solving ## \sum_b u_{bj}^m d(x_b, p) ^ e => \min_p ## ## As we refer to consensus methods by their *name* (e.g., 'HBH'), ## we rely on the registration mechanism (set_cl_consensus_method()) ## to provide the required information about d and e. clusterings <- as.cl_ensemble(x) type <- .cl_ensemble_type(clusterings) if(type == "partition") { ## Canonicalize by turning into an ensemble of partitions ## represented by membership matrices with the same (minimal) ## number of columns. memberships <- lapply(clusterings, cl_membership, max(sapply(clusterings, n_of_classes))) clusterings <- cl_ensemble(list = lapply(memberships, as.cl_partition)) } if(!inherits(method, "cl_consensus_method")) { ## Get required information on d and e from the registry. if(is.null(method)) method <- .cl_consensus_method_default(type) method <- get_cl_consensus_method(method, type) ## Note that this avoids registry lookup in subsequent calls to ## cl_consensus(). if(is.null(method$exponent)) stop("No information on exponent in consensus method used.") e <- method$exponent if(is.null(method$dissimilarity)) stop("No information on dissimilarity in consensus method used.") d <- function(x, y = NULL) cl_dissimilarity(x, y, method = method$dissimilarity) } family <- pclust_family(D = d, C = method$definition, e = e) out <- pclust(x, k, family, m, weights, control) ## Massage the results a bit. dissimilarities <- as.matrix(d(clusterings) ^ e) out$call <- match.call() out <- .structure(c(out, list(silhouette = silhouette(out$cluster, dmatrix = dissimilarities), validity = cl_validity(cl_membership(out), dissimilarities), ## ## Information about d and e is also in the ## family returned, of course. Trying to be ## nice to users by "directly" providing d ## and e is currently of limited usefulness ## as the pclust representation is not ## directly available to users. d = d, e = e ## )), class = unique(c("cl_pclust", class(out)))) as.cl_partition(out) } print.cl_pclust <- function(x, ...) { txt <- if(x$m == 1) gettextf("A hard partition of a cluster ensemble with %d elements into %d classes.", n_of_objects(x), n_of_classes(x)) else gettextf("A soft partition (degree m = %f) of a cluster ensemble with %d elements into %d classes.", x$m, n_of_objects(x), n_of_classes(x)) writeLines(strwrap(txt)) NextMethod("print", x, header = FALSE) print(x$validity, ...) invisible(x) } ### * pclust pclust <- function(x, k, family, m = 1, weights = 1, control = list()) { ## A general purpose alternating optimization algorithm for ## prototype-based partitioning. ## For now, assume family specifies three functions: ## * A dissimilarity function D() for data and prototypes. ## * A consensus function C() for data, weights and control. ## * An init function init() of data and k giving an initial object ## of k prototypes. ## ## We use k as the second argument as this seems to be common ## practice for partitioning algorithms. ## ## We assume that consensus functions can all handle WEIGHTS ## (formals: x, weights, control; only used positionally). ## ## ## We now allow for arbitrary representations/objects of prototypes. ## What is needed are functions to modify a *single* prototype and ## subset the prototypes. By default, list and matrix (with the ## usual convention that rows are "objects") representations are ## supported. Otherwise, the family needs to provide suitable ## .modify() and .subset() functions. ## The approach relies on having the initializer of the family ## (init()) return an appropriate object of prototypes. ## It would be possible to have default initializers as well to ## randomly subset the data (i.e., select elements of lists or rows ## of matrices, respectively). ## ## ## The 'prototypes' are not necessarily objects of the same kind as ## the data objects. Therefore, D() is really a 2-argument ## cross-dissimilarity function. ## It would also be useful to have a way of computing the pairwise ## dissimilarities between objects: but this is something different ## from D() is objects and prototypes are not of the same kind. ## A "clean" solution could consist in specifying the family either ## via a (non-symmetric) cross-dissimilarity function X(), or a ## symmetric D() which when called with a single argument gives the ## pairwise object dissimilarities. ## I.e., ## pclust_family(D = NULL, C, init = NULL, X = NULL, ......) ## using ## * If both D and X are not given => TROUBLE. ## * If only D is given: use for X as well. ## * If only X is given: only use as such. ## Something for the future ... ## ## ## If people have code for computing cross-dissimilarities for the ## data and a *single* prototype (say, xd()), they can easily wrap ## into what is needed using ## t(sapply(prototypes, function(p) xd(x, p))) ## Assuming symmetry of the dissimilarity, they could also do ## t(sapply(prototypes, xd, x)) ## ## Perhaps check whether 'family' is a feasible/suitable pclust ## family (object). D <- family$D C <- family$C e <- family$e .modify <- family$.modify .subset <- family$.subset maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 100L nruns <- control$nruns reltol <- control$reltol if(is.null(reltol)) reltol <- sqrt(.Machine$double.eps) start <- control$start verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Do this at last ... control <- as.list(control$control) ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } nruns <- length(start) } else { if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } start <- replicate(nruns, family$init(x, k), simplify = FALSE) } ## Initialize. ## We need to do this here because it is (currently) the only way to ## figure out the number B of objects to be partitioned (which is ## needed for getting the object weights to the right length). prototypes <- start[[1L]] dissimilarities <- D(x, prototypes) ^ e B <- NROW(dissimilarities) ## Also try to figure out (if necessary) how to modify a single ## prototype and to subset the prototypes. Note that we can only ## check this *after* prototypes were obtained (and not when the ## family object is created). if(is.null(.modify)) { if(is.list(prototypes)) .modify <- function(x, i, value) { x[[i]] <- value x } else if(is.matrix(prototypes)) .modify <- function(x, i, value) { x[i, ] <- value x } else stop("Cannot determine how to modify prototypes.") } else if(!is.function(.modify) || !identical(formals(args(.modify)), c("x", "i", "value"))) stop("Invalid function to modify prototypes.") if(is.null(.subset)) { if(is.list(prototypes)) .subset <- `[` else if(is.matrix(prototypes)) .subset <- function(x, i) x[i, , drop = FALSE] else stop("Cannot determine how to subset prototypes.") } else if(!is.function(.subset) || !identical(formals(args(.subset)), c("x", "i"))) stop("Invalid function to subset prototypes.") weights <- rep_len(weights, B) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") ## A little helper. .make_unit_weights <- function(B, i) { out <- double(B) out[i] <- 1 out } if(m == 1) { ## Hard partitions. value <- if(all(weights == 1)) function(dissimilarities, ids) sum(.one_entry_per_column(dissimilarities, ids)) else function(dissimilarities, ids) sum(weights * .one_entry_per_column(dissimilarities, ids)) opt_value <- Inf run <- 1L if(verbose && (nruns > 1L)) message(gettextf("Pclust run: %d", run)) repeat { class_ids <- max.col( - dissimilarities ) old_value <- value(dissimilarities, class_ids) if(verbose) message(gettextf("Iteration: 0 *** value: %g", old_value)) iter <- 1L while(iter <= maxiter) { class_ids_used <- unique(class_ids) for(j in class_ids_used) prototypes <- .modify(prototypes, j, C(x, weights * (class_ids %in% j), control)) dissimilarities <- D(x, prototypes) ^ e class_ids <- max.col( - dissimilarities ) ## Try avoiding degenerate solutions. if(length(class_ids_used) < k) { ## Find the k - l largest ## object-to-assigned-prototype dissimilarities. o <- order(.one_entry_per_column(dissimilarities, class_ids), decreasing = TRUE) ## Find and recompute unused prototypes. unused <- setdiff(seq_len(k), class_ids_used) for(j in seq_along(unused)) prototypes <- .modify(prototypes, unused[j], C(x, .make_unit_weights(B, o[j]), control)) dissimilarities[, unused] <- D(x, .subset(prototypes, unused)) ^ e class_ids <- max.col( - dissimilarities ) ## For the time being, do not retry in case the ## solution is still degenerate. } new_value <- value(dissimilarities, class_ids) if(verbose) message(gettextf("Iteration: %d *** value: %g", iter, new_value)) if(abs(old_value - new_value) < reltol * (abs(old_value) + reltol)) break old_value <- new_value iter <- iter + 1L } if(new_value < opt_value) { converged <- (iter <= maxiter) opt_value <- new_value opt_class_ids <- class_ids opt_prototypes <- prototypes } if(run >= nruns) break run <- run + 1L if(verbose) message(gettextf("Pclust run: %d", run)) prototypes <- start[[run]] dissimilarities <- D(x, prototypes) ^ e } ## We should really have a suitable "sparse matrix" class for ## representing the memberships of hard partitions. For now: opt_u <- NULL ## opt_u <- matrix(0, B, k) ## opt_u[cbind(seq_len(B), opt_class_ids)] <- 1 } else { ## Soft partitions. value <- if(all(weights == 1)) function(dissimilarities, u) sum(u ^ m * dissimilarities) else function(dissimilarities, u) sum(weights * u ^ m * dissimilarities) opt_value <- Inf run <- 1L if(verbose && (nruns > 1L)) message(gettextf("Pclust run: %d", run)) repeat { u <- .memberships_from_cross_dissimilarities(dissimilarities, m) old_value <- value(dissimilarities, u) if(verbose) message(gettextf("Iteration: 0 *** value: %g", old_value)) iter <- 1L while(iter <= maxiter) { ## Update the prototypes. ## This amounts to solving, for each j: ## \sum_b w_b u_{bj}^m D(x_b, p) ^ e => \min_p ## I.e., p_j is the *weighted* consensus of the x_b with ## corresponding weights u_{bj}^m. for(j in seq_len(k)) { prototypes <- .modify(prototypes, j, C(x, weights * u[, j] ^ m, control)) } ## Update u. dissimilarities <- D(x, prototypes) ^ e u <- .memberships_from_cross_dissimilarities(dissimilarities, m) new_value <- value(dissimilarities, u) if(verbose) message(gettextf("Iteration: %d *** value: %g", iter, new_value)) if(abs(old_value - new_value) < reltol * (abs(old_value) + reltol)) break old_value <- new_value iter <- iter + 1L } if(new_value < opt_value) { converged <- (iter <= maxiter) opt_value <- new_value opt_prototypes <- prototypes opt_u <- u } if(run >= nruns) break run <- run + 1L if(verbose) message(gettextf("Pclust run: %d", run)) prototypes <- start[[run]] dissimilarities <- D(x, prototypes) ^ e } opt_class_ids <- max.col(opt_u) ## Ensure that opt_u is a stochastic matrix. opt_u <- pmax(opt_u, 0) opt_u <- opt_u / rowSums(opt_u) rownames(opt_u) <- rownames(dissimilarities) opt_u <- cl_membership(as.cl_membership(opt_u), k) } names(opt_class_ids) <- rownames(dissimilarities) pclust_object(prototypes = opt_prototypes, membership = opt_u, cluster = opt_class_ids, family = family, m = m, value = opt_value, call = match.call(), attributes = list("converged" = converged)) } print.pclust <- function(x, header = TRUE, ...) { is_hard <- (x$m == 1) class_ids <- cl_class_ids(x) if(header) { txt <- if(is_hard) gettextf("A hard partition of %d objects into %d classes.", length(class_ids), n_of_classes(x)) else gettextf("A soft partition (degree m = %f) of %d objects into %d classes.", x$m, length(class_ids), n_of_classes(x)) writeLines(strwrap(txt)) } if(is_hard) { print(class_ids, ...) } else { writeLines("Class memberships:") print(cl_membership(x), ...) writeLines("Class ids of closest hard partition:") print(unclass(class_ids), ...) } invisible(x) } ### * pclust_family pclust_family <- function(D, C, init = NULL, description = NULL, e = 1, .modify = NULL, .subset = NULL) { ## Add checking formals (lengths) eventually ... if(is.null(init)) { ## Works for list representations ... init <- function(x, k) sample(x, k) } .structure(list(description = description, D = D, C = C, init = init, e = e, .modify = .modify, .subset = .subset), class = "pclust_family") } ### * pclust_object pclust_object <- function(prototypes, membership, cluster, family, m = 1, value, ..., classes = NULL, attributes = NULL) { out <- c(list(prototypes = prototypes, membership = membership, cluster = cluster, family = family, m = m, value = value), list(...)) attributes(out) <- c(attributes(out), attributes) classes <- unique(as.character(classes)) class(out) <- c(classes[classes != "pclust"], "pclust") out } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/membership.R0000644000175100001440000001737311633352676013726 0ustar hornikusers### * cl_membership ## Get the class membership matrix from a partition. ## ## We could use sparse matrices for the memberships of hard partitions. ## Not sure if this is really that important, though, as we typically ## use memberships in a context where dense matrices (memberships of ## soft partitions) occur. ## ## ## Currently, the number of classes to be used for the memberships must ## not be less than the number of classes in the partition. We might ## eventually change this so that "optimal" collapsing of classes is ## performed (but note that optimality needs to be relative to some ## dissimilarity measure) ... ## However, from the discussion of the second method in Gordon and Vichi ## (2001) we note that whereas optimal assignment is "simple", optimal ## collapsing (equivalent to partitioning into an arbitrary number of ## partitions) is of course very hard. ## cl_membership <- function(x, k = n_of_classes(x)) { if(k < n_of_classes(x)) stop("k cannot be less than the number of classes in x.") UseMethod("cl_membership") } ## Default method. cl_membership.default <- function(x, k = n_of_classes(x)) .cl_membership_from_class_ids(cl_class_ids(x), k) ## Package stats: kmeans() (R 2.1.0 or better). cl_membership.kmeans <- cl_membership.default ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". cl_membership.fanny <- function(x, k = n_of_classes(x)) .cl_membership_from_memberships(x$membership, k) cl_membership.partition <- cl_membership.default ## Package cclust: cclust(). cl_membership.cclust <- cl_membership.default ## Package e1071: cmeans() gives objects of class "fclust". cl_membership.fclust <- cl_membership.fanny ## Package e1071: cshell(). cl_membership.cshell <- cl_membership.fanny ## Package e1071: bclust(). cl_membership.bclust <- cl_membership.default ## Package flexmix: class "flexmix". ## ## We used to be able to call flexmix::posterior(), but this now only ## has S4 methods for modeltools::posterior() S4 generic. Let's call ## this one, and hope that flexmix has been loaded ... ## cl_membership.flexmix <- function(x, k = n_of_classes(x)) .cl_membership_from_memberships(modeltools::posterior(x), k) ## Package mclust: Mclust(). cl_membership.Mclust <- function(x, k = n_of_classes(x)) .cl_membership_from_memberships(x$z, k) ## Package clue: Memberships. cl_membership.cl_membership <- function(x, k = n_of_classes(x)) .cl_membership_from_memberships(x, k) ## (Note: we cannot simply return x in case k equals n_of_classes(x), ## because ncol(x) might be different.) ## Package clue: pclust(). cl_membership.pclust <- function(x, k = n_of_classes(x)) { ## We should really have a suitable "sparse matrix" class for ## representing the memberships of hard partitions. In case we ## decide not to fill the membership "slot" for such: if(is.null(m <- x$membership)) .cl_membership_from_class_ids(x$cluster, k) else .cl_membership_from_memberships(m, k) } ## Package clue: (virtual) class "cl_partition". cl_membership.cl_partition <- function(x, k = n_of_classes(x)) cl_membership(.get_representation(x), k) ## Package movMF: class "movMF". cl_membership.movMF <- function(x, k = n_of_classes(x)) .cl_membership_from_memberships(x$P, k) ### * .make_cl_membership ## A low-level common creator. .make_cl_membership <- function(x, n_of_classes, is_cl_hard_partition, meta = NULL) { attr(x, "n_of_classes") <- n_of_classes attr(x, "is_cl_hard_partition") <- is_cl_hard_partition attr(x, "meta") <- meta class(x) <- "cl_membership" x } ### * .cl_membership_from_class_ids .cl_membership_from_class_ids <- function(x, k = NULL, meta = NULL) { x <- factor(x) n_of_objects <- length(x) n_of_classes <- nlevels(x) if(is.null(k)) k <- n_of_classes else if(k < n_of_classes) stop("k cannot be less than the number of classes in x.") ## ## Should really use a sparse encoding of this ... M <- matrix(0, n_of_objects, k) ## (Could also use .one_entry_per_column(M, as.numeric(x)) <- 1 for ## the time being.) M[cbind(seq_len(n_of_objects), as.numeric(x))] <- 1 ## But note that we also need to handle NAs ... M[is.na(x), ] <- NA ## if(nlevels(x) == k) colnames(M) <- levels(x) if(!is.null(nm <- names(x))) rownames(M) <- nm .make_cl_membership(M, n_of_classes, TRUE, meta) } ### * .cl_membership_from_memberships .cl_membership_from_memberships <- function(x, k = NULL, meta = NULL) { ## ## Dropping and re-filling of ## zero columns in case k is given may ## seem unnecessary, but really canonicalizes by moving zero columns ## last ... ## x <- x[ , colSums(x, na.rm = TRUE) > 0, drop = FALSE] n_of_classes <- ncol(x) if(!is.null(k)) { if(k < n_of_classes) stop("k cannot be less than the number of classes in x.") if(k > n_of_classes) { ## Fill up with zero columns. x <- cbind(x, matrix(0, nrow(x), k - n_of_classes)) ## Handle NAs if necessary. x[apply(is.na(x), 1, any), ] <- NA } } .make_cl_membership(x, n_of_classes, all(rowSums(x == 1, na.rm = TRUE) > 0), meta) } ### * as.cl_membership as.cl_membership <- function(x) UseMethod("as.cl_membership") as.cl_membership.default <- function(x) { if(inherits(x, "cl_membership")) x else if(is.atomic(x)) .cl_membership_from_class_ids(x) else cl_membership(x) } as.cl_membership.matrix <- function(x) .cl_membership_from_memberships(x) ### * .memberships_from_cross_dissimilarities .memberships_from_cross_dissimilarities <- function(d, power = 2) { ## For a given matrix of cross-dissimilarities [d_{bj}], return a ## matrix [u_{bj}] such that \sum_{b,j} u_{bj}^p d_{bj}^q => min! ## under the constraint that u is a stochastic matrix. ## If only one power is given, it is taken as p, with q as 1. ## ## This returns a plain matrix of membership values and not a ## cl_membership object (so that it does not deal with possibly ## dropping or re-introducing unused classes). ## exponent <- if(length(power) == 1L) 1 / (1 - power) else power[2L] / (1 - power[1L]) u <- matrix(0, nrow(d), ncol(d)) zero_incidences <- !(d > 0) n_of_zeroes <- rowSums(zero_incidences) if(any(ind <- (n_of_zeroes > 0))) u[ind, ] <- zero_incidences[ind, , drop = FALSE] / n_of_zeroes[ind] if(any(!ind)) { ## Compute d_{bj}^e / \sum_k d_{bk}^e without overflow from very ## small d_{bj} values. d <- exponent * log(d[!ind, , drop = FALSE]) d <- exp(d - d[cbind(seq_len(nrow(d)), max.col(d))]) u[!ind, ] <- d / rowSums(d) } u } ### * print.cl_membership print.cl_membership <- function(x, ...) { writeLines("Memberships:") print(matrix(as.vector(x), nrow = nrow(x), dimnames = dimnames(x)), ...) invisible(x) } ### .has_object_memberships ## Be nice to users when computing proximities: all measures for ## "partitions" we currently consider really only assume that we can ## compute memberships and/or class ids. ## Note that the cl_membership() default method works for cl_class_ids. .has_object_memberships <- function(x) (is.cl_partition(x) || inherits(x, "cl_membership") || inherits(x, "cl_class_ids")) ### * .stochastify .stochastify <- function(x) { ## Try to ensure that a stochastic matrix is returned. x <- pmax(x, 0) x / rowSums(x) } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/partition.R0000644000175100001440000004352212212427231013557 0ustar hornikusers### * n_of_classes ## Get the number of classes in a (hard or soft) partition. ## ## We generally allow for classes to be empty, unlike the current ## version of kmeans(). Package cclust has a version of k-means which ## does not stop in case of empty classes. ## However, we only count NON-EMPTY classes here. ## n_of_classes <- function(x) UseMethod("n_of_classes") ## Default method. n_of_classes.default <- function(x) length(unique(cl_class_ids(x))) ## Package stats: kmeans() (R 2.1.0 or better). n_of_classes.kmeans <- n_of_classes.default ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". n_of_classes.fanny <- function(x) sum(colSums(x$membership, na.rm = TRUE) > 0) n_of_classes.partition <- n_of_classes.default ## Package cclust: cclust(). n_of_classes.cclust <- n_of_classes.default ## Package e1071: cmeans() gives objects of class "fclust". n_of_classes.fclust <- n_of_classes.fanny ## Package e1071: cshell(). n_of_classes.cshell <- n_of_classes.fanny ## Package e1071: bclust(). n_of_classes.bclust <- n_of_classes.default ## Package mclust: Mclust(). n_of_classes.Mclust <- n_of_classes.default ## Package clue: Memberships. n_of_classes.cl_membership <- function(x) attr(x, "n_of_classes") ## Package clue: pclust(). n_of_classes.pclust <- function(x) { if(is.null(m <- x$membership)) length(unique(cl_class_ids(x))) else sum(colSums(m, na.rm = TRUE) > 0) } ## Package clue: (virtual) class "cl_partition". n_of_classes.cl_partition <- function(x) n_of_classes(.get_representation(x)) ### * cl_class_ids ## Get ids of classes in a partition. ## ## Currently, all supported soft partitioning methods provide a softmax ## hard partitioning as well. ## cl_class_ids <- function(x) UseMethod("cl_class_ids") ## Default method. cl_class_ids.default <- function(x) { stop("Cannot infer class ids from given object.") } ## Package stats: kmeans() (R 2.1.0 or better). cl_class_ids.kmeans <- function(x) as.cl_class_ids(x$cluster) ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". cl_class_ids.partition <- function(x) as.cl_class_ids(x$clustering) ## Package RWeka: clusterers return objects inheriting from ## "Weka_clusterer". cl_class_ids.Weka_clusterer <- function(x) as.cl_class_ids(x$class_ids) ## Package cba: ccfkms(). cl_class_ids.ccfkms <- function(x) as.cl_class_ids(as.vector(x$cl)) ## Package cba: rockCluster() returns objects of class "rock". cl_class_ids.rock <- function(x) as.cl_class_ids(as.vector(x$cl)) ## Package cclust: cclust(). cl_class_ids.cclust <- cl_class_ids.kmeans ## Package e1071: cmeans() gives objects of class "fclust". cl_class_ids.fclust <- cl_class_ids.kmeans ## Package e1071: cshell(). cl_class_ids.cshell <- cl_class_ids.kmeans ## Package e1071: bclust(). cl_class_ids.bclust <- cl_class_ids.kmeans ## Package flexclust: kcca() returns objects of S4 class "kcca" which ## extends S4 class "flexclust". ## ## We used to be able to call flexclust::cluster(), but this now only ## has S4 methods for modeltools::clusters() S4 generic. Let's call this ## one, and hope that flexclust has been loaded ... ## cl_class_ids.kcca <- function(x) as.cl_class_ids(modeltools::clusters(x)) ## Package flexmix: class "flexmix". ## ## We used to be able to call flexmix::cluster(), but this now only has ## S4 methods for modeltools::clusters() S4 generic. Let's call this ## one, and hope that flexmix has been loaded ... ## cl_class_ids.flexmix <- function(x) as.cl_class_ids(modeltools::clusters(x)) ## Package kernlab: specc() and kkmeans() return objects of S4 class ## "specc". cl_class_ids.specc <- function(x) { tmp <- unclass(x) as.cl_class_ids(.structure(as.vector(tmp), names = names(tmp))) } ## Package mclust: Mclust(). cl_class_ids.Mclust <- function(x) as.cl_class_ids(x$classification) ## Package relations: equivalence and preference relations. cl_class_ids.relation <- function(x) as.cl_class_ids(relations::relation_class_ids(x)) ## Package clue: Class ids. cl_class_ids.cl_class_ids <- identity ## Package clue: Memberships. cl_class_ids.cl_membership <- function(x) as.cl_class_ids(.structure(max.col(x), names = rownames(x))) ## (Cannot do cl_class_ids.cl_membership <- max.col for generic/method ## consistency.) ## Package clue: cl_pam(). cl_class_ids.cl_pam <- cl_class_ids.kmeans ## Package clue: cl_partition_by_class_ids(). cl_class_ids.cl_partition_by_class_ids <- function(x) .get_representation(x) ## Package clue: kmedoids(). cl_class_ids.kmedoids <- cl_class_ids.kmeans ## Package clue: pclust(). cl_class_ids.pclust <- cl_class_ids.kmeans ## Package clue: (virtual) class "cl_partition". cl_class_ids.cl_partition <- function(x) cl_class_ids(.get_representation(x)) ## Package movMF: class "movMF". cl_class_ids.movMF <- function(x) as.cl_class_ids(max.col(x$P)) ### * as.cl_class_ids as.cl_class_ids <- function(x) { ## For the time being, handle only "raw" class ids. ## Maybe add methods handling factors lateron (if necessary). ## ## This could also be used to canonicalize returned class ids ## according to the docs (vector of integers with the class ids), ## using someting like ## match(ids, unique(ids)) ## .structure(unclass(x), class = "cl_class_ids") } ### * print.cl_class_ids print.cl_class_ids <- function(x, ...) { writeLines("Class ids:") print(unclass(x), ...) invisible(x) } ### * cl_class_labels cl_class_labels <- function(x) UseMethod("cl_class_labels") ### * is.cl_partition ## Determine whether an object is a (generalized) partition. ## Note that this includes both hard and soft partitions, and allows ## sums of memberships of objects to be less than one. is.cl_partition <- function(x) UseMethod("is.cl_partition") ## Default method. is.cl_partition.default <- .false ## Package stats: kmeans() (R 2.1.0 or better). is.cl_partition.kmeans <- .true ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". is.cl_partition.partition <- .true ## Package RWeka: clusterers return objects inheriting from ## "Weka_clusterer". ## (Note that Cobweb internally uses a classification tree, but ## definitely does not expose this structure.) is.cl_partition.Weka_clusterer <- .true ## Package cba: ccfkms(). is.cl_partition.ccfkms <- .true ## Package cba: rockCluster() returns objects of class "rock". is.cl_partition.rock <- .true ## Package cclust: cclust(). is.cl_partition.cclust <- .true ## Package e1071: cmeans() gives objects of class "fclust". is.cl_partition.fclust <- .true ## Package e1071: cshell(). is.cl_partition.cshell <- .true ## Package e1071: bclust(). is.cl_partition.bclust <- .true ## Package flexclust: kcca() returns objects of S4 class "kcca" which ## extends S4 class "flexclust". is.cl_partition.kcca <- .true ## Package flexmix: class "flexmix". is.cl_partition.flexmix <- .true ## Package kernlab: specc() and kkmeans() return objects of S4 class ## "specc". is.cl_partition.specc <- .true ## Package mclust: Mclust(). is.cl_partition.Mclust <- .true ## Package clue: (virtual) class "cl_partition". ## Note that "raw" cl_membership objects are *not* partitions, as they ## are meant for numeric computations. is.cl_partition.cl_partition <- .true ## Package clue: kmedoids(). is.cl_partition.kmedoids <- .true ## Package clue: pclust(). is.cl_partition.pclust <- .true ## Package movMF: class "movMF". is.cl_partition.movMF <- .true ### * as.cl_partition ## Note that cl_partition conceptually is a virtual class, so there are ## no prototypes and no cl_partition() creator. .cl_partition_classes <- "cl_partition" as.cl_partition <- function(x) { if(is.cl_partition(x)) { if(!inherits(x, "cl_partition")) .make_container(x, .cl_partition_classes) else x } else cl_partition_by_memberships(as.cl_membership(x)) } ### * print.cl_partition print.cl_partition <- function(x, ...) .print_container(x, "cl_partition", ...) ### * print.cl_partition_by_class_ids print.cl_partition_by_class_ids <- function(x, ...) { writeLines(gettextf("A hard partition of %d objects.", n_of_objects(x))) print(cl_class_ids(x), ...) invisible(x) } ### * print.cl_partition_by_memberships print.cl_partition_by_memberships <- function(x, ...) { writeLines(gettextf("A partition of %d objects.", n_of_objects(x))) print(cl_membership(x), ...) invisible(x) } ### * Complex.cl_partition Complex.cl_partition <- function(z) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ### * Math.cl_partition Math.cl_partition <- function(x, ...) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ### * Ops.cl_partition Ops.cl_partition <- function(e1, e2) { if(nargs() == 1L) stop(gettextf("Unary '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ## Only comparisons are supprorted. if(!(as.character(.Generic) %in% c("<", "<=", ">", ">=", "==", "!="))) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ci1 <- cl_class_ids(e1) ci2 <- cl_class_ids(e2) if(length(ci1) != length(ci2)) stop("Partitions must have the same number of objects.") z <- table(ci1, ci2) > 0 switch(.Generic, "<=" = all(rowSums(z) == 1), "<" = all(rowSums(z) == 1) && any(colSums(z) > 1), ">=" = all(colSums(z) == 1), ">" = all(colSums(z) == 1) && any(rowSums(z) > 1), "==" = all(rowSums(z) == 1) && all(colSums(z) == 1), "!=" = any(rowSums(z) > 1) || any(colSums(z) > 1)) } ### * Summary.cl_partition Summary.cl_partition <- function(..., na.rm = FALSE) { ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) if(!ok) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) args <- list(...) switch(.Generic, "min" = cl_meet(cl_ensemble(list = args)), "max" = cl_join(cl_ensemble(list = args)), "range" = { cl_ensemble(min = cl_meet(cl_ensemble(list = args)), max = cl_join(cl_ensemble(list = args))) }) } ### * cl_partition_by_class_ids cl_partition_by_class_ids <- function(x, labels = NULL) { if(!is.atomic(x)) stop("Class ids must be atomic.") if(is.null(names(x))) names(x) <- labels ## ## Perhaps give the raw class ids more structure? ## E.g, class "cl_class_ids"? ## Problem is that we used to say about extensibility that all there ## is to do for a hard partitioner is to add a cl_class_ids() method ## and two predicates, but *not* to have the former give a suitably ## classed object. On the other hand, the recipe would need to be ## extended for soft partitioners, for which it would be necessary ## to provide a cl_membership() method which really returns an ## object of class cl_membership. Note that we can do this using ## as.cl_membership(m), where m is the raw membership matrix. So ## maybe we should ask for using as.cl_class_ids() to coerce raw ## class ids ... .make_container(as.cl_class_ids(x), c("cl_partition_by_class_ids", .cl_hard_partition_classes), list(n_of_objects = length(x), n_of_classes = length(unique(x)))) ## } ### * cl_partition_by_memberships cl_partition_by_memberships <- function(x, labels = NULL) { if(!is.matrix(x) || any(x < 0, na.rm = TRUE) || any(x > 1, na.rm = TRUE)) stop("Not a valid membership matrix.") ## Be nice. x <- x / rowSums(x, na.rm = TRUE) ## (Note that this does not imply all(rowSums(x) == 1). If we ## wanted to test for this, something like ## .is_stochastic_matrix <- function(x) ## identical(all.equal(rowSums(x), rep(1, nrow(x))), TRUE)) ## should do.) if(is.null(rownames(x))) rownames(x) <- labels .make_container(as.cl_membership(x), c("cl_partition_by_memberships", .cl_partition_classes), list(n_of_objects = nrow(x))) } ### * is.cl_hard_partition ## Determine whether an object is a hard partition. is.cl_hard_partition <- function(x) UseMethod("is.cl_hard_partition") ## Default method. is.cl_hard_partition.default <- .false ## Package stats: kmeans() (R 2.1.0 or better). is.cl_hard_partition.kmeans <- .true ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". ## ## Of course, fuzzy clustering can also give a hard partition ... is.cl_hard_partition.fanny <- function(x) { all(rowSums(cl_membership(x) == 1, na.rm = TRUE) > 0) } ## is.cl_hard_partition.partition <- .true ## Package RWeka: clusterers return objects inheriting from ## "Weka_clusterer". is.cl_hard_partition.Weka_clusterer <- .true ## Package cba: ccfkms(). is.cl_hard_partition.ccfkms <- .true ## Package cba: rockCluster() returns objects of class "rock". is.cl_hard_partition.rock <- .true ## Package cclust: cclust(). is.cl_hard_partition.cclust <- .true ## Package e1071: cmeans() gives objects of class "fclust". is.cl_hard_partition.fclust <- is.cl_hard_partition.fanny ## Package e1071: cshell(). is.cl_hard_partition.cshell <- is.cl_hard_partition.fanny ## Package e1071: bclust(). is.cl_hard_partition.bclust <- .true ## Package flexclust: kcca() returns objects of S4 class "kcca" which ## extends S4 class "flexclust". is.cl_hard_partition.kcca <- .true ## Package flexmix: class "flexmix". is.cl_hard_partition.flexmix <- is.cl_hard_partition.fanny ## Package kernlab: specc() and kkmeans() return objects of S4 class ## "specc". is.cl_hard_partition.specc <- .true ## Package mclust: Mclust(). is.cl_hard_partition.Mclust <- is.cl_hard_partition.fanny ## Package clue: (virtual) class "cl_hard_partition". is.cl_hard_partition.cl_hard_partition <- .true ## Package clue: (virtual) class "cl_partition". ## Note that "raw" cl_membership objects are *not* partitions, as they ## are meant for numeric computations. ## Rather than providing is.cl_hard_partition.cl_membership() we thus ## prefer explicit handling of cl_partition objects with a cl_membership ## representation. is.cl_hard_partition.cl_partition <- function(x) { ## If the object has a cl_membership representation ... y <- .get_representation(x) if(inherits(y, "cl_membership")) attr(y, "is_cl_hard_partition") ## Other representations, e.g. for "definitely" hard partitions via ## vectors of class ids or class labels, or a list of classes, may ## be added in future versions. ## In any case, this must be kept in sync with what is handled by ## as.cl_partition() [which currently runs as.cl_membership() in ## case is.cl_partition() gives false]. else is.cl_hard_partition(y) } ## Package clue: kmedoids(). is.cl_hard_partition.kmedoids <- .true ## Package clue: pclust(). is.cl_hard_partition.pclust <- is.cl_hard_partition.fanny ## Package movMF: class "movMF". is.cl_hard_partition.movMF <- is.cl_hard_partition.fanny ### * as.cl_hard_partition .cl_hard_partition_classes <- c("cl_hard_partition", "cl_partition") as.cl_hard_partition <- function(x) { if(is.cl_hard_partition(x)) { if(!inherits(x, "cl_partition")) .make_container(x, .cl_hard_partition_classes) else x } else if(is.cl_partition(x)) { ## A soft cl_partition ... ids <- cl_class_ids(x) cl_partition_by_class_ids(ids, names(ids)) } else if(is.matrix(x)) { ## A matrix of raw memberships, hopefully ... cl_partition_by_class_ids(max.col(x), rownames(x)) } else if(is.atomic(x)) { ## A vector of raw class ids, hopefully ... cl_partition_by_class_ids(x, names(x)) } else stop("Cannot coerce to 'cl_hard_partition'.") } ### * is.cl_soft_partition ## Determine whether an object is a soft partition. is.cl_soft_partition <- function(x) is.cl_partition(x) && ! is.cl_hard_partition(x) ### * .maybe_is_proper_soft_partition ## Determine whether an object might be a proper soft partition (in the ## sense that it is a cl_partition but not a cl_hard_partition). ## This is mostly useful when computing fuzziness measures. .maybe_is_proper_soft_partition <- function(x) UseMethod(".maybe_is_proper_soft_partition") .maybe_is_proper_soft_partition.default <- .false .maybe_is_proper_soft_partition.fanny <- .true .maybe_is_proper_soft_partition.fclust <- .true .maybe_is_proper_soft_partition.cshell <- .true .maybe_is_proper_soft_partition.flexmix <- .true .maybe_is_proper_soft_partition.Mclust <- .true ## See above for why we prefer not to have ## .maybe_is_proper_soft_partition.cl_membership(). ## (Although this is an internal generic really only used for making ## cl_fuzziness() computations more efficient, so we could be more ## generous here [perhaps using a slightly different name such as ## .maybe_represents_a_proper_soft_partition()]. .maybe_is_proper_soft_partition.cl_partition <- function(x) { y <- .get_representation(x) if(inherits(y, "cl_membership")) !attr(y, "is_cl_hard_partition") else .maybe_is_proper_soft_partition(y) } .maybe_is_proper_soft_partition.pclust <- function(x) x$m > 1 ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/boot.R0000644000175100001440000000255711304023136012511 0ustar hornikuserscl_boot <- function(x, B, k = NULL, algorithm = if(is.null(k)) "hclust" else "kmeans", parameters = list(), resample = FALSE) { clusterings <- if(!resample) { x <- rep.int(list(x), B) eval(as.call(c(list(as.name("lapply"), x, algorithm), if(!is.null(k)) list(k), parameters))) } else { replicate(B, expr = { algorithm <- match.fun(algorithm) ## ## This is not quite perfect. We have ## cl_predict() to encapsulate the process of ## assigning objects to classes, but for sampling ## from the objects we assume that they correspond ## to the *rows* of 'x'. Argh. ## ind <- sample(NROW(x), replace = TRUE) train <- if(length(dim(x)) == 2) x[ind, ] else x[ind] out <- eval(as.call(c(list(algorithm, train), if(!is.null(k)) list(k), parameters))) as.cl_partition(cl_predict(out, x, "memberships")) }, simplify = FALSE) } cl_ensemble(list = clusterings) } clue/R/lattice.R0000644000175100001440000001356713036514161013205 0ustar hornikuserscl_meet <- function(x, y) { ## General case. ## x either an ensemble, or x and y two clusterings with the same ## number of objects. if(!inherits(x, "cl_ensemble")) { ## Be nice about error messages. if(n_of_objects(x) != n_of_objects(y)) stop("Arguments 'x' and 'y' must have the same number of objects.") x <- cl_ensemble(x, y) } if(inherits(x, "cl_partition_ensemble")) .cl_meet_partition(x) else if(inherits(x, "cl_dendrogram_ensemble")) .cl_meet_dendrogram(x) else if(inherits(x, "cl_hierarchy_ensemble")) .cl_meet_hierarchy(x) else stop("Cannot compute meet of given clusterings.") } .cl_meet_partition <- function(x) { x <- unique(x) if(length(x) == 1L) return(cl_partition_by_class_ids(cl_class_ids(x[[1L]]))) ids <- seq_len(n_of_objects(x[[1L]])) ## Cross-classify the objects. z <- split(ids, lapply(x, cl_class_ids)) ## Subscript on the non-empty cells to get adjacent class ids. lens <- lengths(z) pos <- which(lens > 0) ids[unlist(z, use.names = FALSE)] <- rep.int(seq_along(z[pos]), lens[pos]) cl_partition_by_class_ids(ids) } .cl_meet_dendrogram <- function(x) { ## Meet of an ensemble of dendrograms. ## We need the maximal ultrametric dominated by the given ones, ## which can be obtained by hierarchical clustering with single ## linkage on the pointwise minima of the ultrametrics. as.cl_dendrogram(hclust(as.dist(do.call(pmin, lapply(x, cl_ultrametric))), "single")) } .cl_meet_hierarchy <- function(x) { ## Meet of an ensemble of n-trees. ## Need to find the classes in *all* n-trees. ## Equivalent to computing a strict majority tree. .cl_consensus_hierarchy_majority(x, rep.int(1, length(x)), list(p = 1)) } cl_join <- function(x, y) { ## General case. ## x either an ensemble, or x and y two clusterings with the same ## number of objects. if(!inherits(x, "cl_ensemble")) { ## Be nice about error messages. if(n_of_objects(x) != n_of_objects(y)) stop("Arguments 'x' and 'y' must have the same number of objects.") x <- cl_ensemble(x, y) } if(inherits(x, "cl_partition_ensemble")) .cl_join_partition(x) else if(inherits(x, "cl_dendrogram_ensemble")) .cl_join_dendrogram(x) else if(inherits(x, "cl_hierarchy_ensemble")) .cl_join_hierarchy(x) else stop("Cannot compute join of given clusterings.") } .cl_join_partition <- function(x) { x <- unique(x) if(length(x) == 1) return(cl_partition_by_class_ids(cl_class_ids(x[[1L]]))) ## Canonicalize: ensure that class ids are always the integers from ## one to the number of classes. n <- sapply(x, n_of_classes) ids <- mapply(function(p, ncp) match(cl_class_ids(p), seq_len(ncp)), x, n, SIMPLIFY = FALSE) ## Order according to the number of classes. ids <- ids[order(n)] ## And now incrementally build the join. jcids <- ids[[1L]] # Class ids of the current join. jnc <- length(unique(jcids)) # Number of classes of this. for(b in seq.int(from = 2, to = length(x))) { z <- table(jcids, ids[[b]]) ## It is faster to work on the smaller partition, but this ## should be ensured by the reordering ... ## We need to "join all elements in the same class in at least ## one of the partitions". In the matrix ## C <- (tcrossprod(z) > 0) ## entry i,j is true/one iff z_{ik} z_{jk} > 0 for classes ## i and j in the current join (ids jcids) and some class k in ## the partition with ids[[b]], so that i and j must be joined. ## I.e., C indicates which classes need to be joined directly. ## We need to determine the transitive closure of this relation, ## which can be performed by repeating ## C_{t+1} <- ((C_t %*% C) > 0) ## with C_1 = C until C_t does not change. C_new <- C_old <- C <- (tcrossprod(z) > 0) repeat { C_new <- (C_old %*% C) > 0 if(all(C_new == C_old)) break C_old <- C_new } C <- C_new ## This should now have the connected components. ## Next, compute the map of the join class ids to the ids of ## these components. cnt <- 0 map <- remaining_ids <- seq_len(jnc) while(length(remaining_ids)) { cnt <- cnt + 1 pos <- which(C[remaining_ids[1L], remaining_ids] > 0) map[remaining_ids[pos]] <- cnt remaining_ids <- remaining_ids[-pos] } ## And update the join: jcids <- map[jcids] jnc <- cnt } cl_partition_by_class_ids(jcids) } .cl_join_dendrogram <- function(x) { ## Join of an ensemble of dendrograms. as.cl_dendrogram(do.call(pmax, lapply(x, cl_ultrametric))) } .cl_join_hierarchy <- function(x) { ## Join of an ensemble of n-trees. ## Only exists if the union of all classes of the n-trees is itself ## an n-tree (see Barthelemy et al). classes <- unique(unlist(lapply(x, cl_classes), recursive = FALSE)) ## Now check if this is an n-tree. ## We must verify that for all classes A and B, their intersection ## is A, B, or empty. check <- function(A, B) { m_AB <- match(A, B) m_BA <- match(B, A) ((all(is.na(m_AB)) && all(is.na(m_BA))) || all(is.finite(m_AB)) || all(is.finite(m_BA))) } for(i in seq_along(classes)) { A <- classes[[i]] for(j in seq_along(classes)) if(!check(A, classes[[j]])) stop("Join of given n-trees does not exist.") } as.cl_hierarchy(.cl_ultrametric_from_classes(classes)) } clue/R/lsap.R0000644000175100001440000000147012036747337012521 0ustar hornikuserssolve_LSAP <- function(x, maximum = FALSE) { if(!is.matrix(x) || any(x < 0)) stop("x must be a matrix with nonnegative entries.") nr <- nrow(x) nc <- ncol(x) if(nr > nc) stop("x must not have more rows than columns.") if(nc > nr) x <- rbind(x, matrix(2 * sum(x), nc - nr, nc)) if(maximum) x <- max(x) - x storage.mode(x) <- "double" out <- .C(C_solve_LSAP, x, as.integer(nc), p = integer(nc))$p + 1 out <- out[seq_len(nr)] class(out) <- "solve_LSAP" out } print.solve_LSAP <- function(x, ...) { writeLines(c("Optimal assignment:", gsub("x", " ", strwrap(paste(seq_along(x), x, sep = "x=>x", collapse = ", "))))) invisible(x) } clue/R/validity.R0000644000175100001440000001002314144531021013360 0ustar hornikusers## A slightly polymorphic function, similar to cluster::silhouette() and ## its methods. cl_validity <- function(x, ...) UseMethod("cl_validity") cl_validity.default <- function(x, d, ...) { ## Note that providing methods for classes "cl_partition" and ## "cl_hierarchy" is not good enough ... out <- list() if(.has_object_memberships(x)) { v <- .cl_validity_partition_d_a_f(cl_membership(x), as.matrix(d)) out <- list("Dissimilarity accounted for" = v) } else if(.has_object_dissimilarities(x)) { x <- cl_object_dissimilarities(x) d <- as.dist(d) out <- list("Variance accounted for" = .cl_validity_hierarchy_variance_a_f(x, d), "Deviance accounted for" = .cl_validity_hierarchy_deviance_a_f(x, d)) ## Consider adding e.g. the Agglomerative Coefficient or ## Divisive Coeffcient for more than cluster::agnes() and ## cluster::diana(), respectively. } class(out) <- "cl_validity" out } ## Package cluster: agnes(). cl_validity.agnes <- function(x, ...) { out <- list("Agglomerative coefficient" = x$ac) ## According to the docs, agnes objects always have a diss ## component, but let's be defensive ... if(!is.null(d <- x$diss)) out <- c(out, cl_validity.default(x, d)) class(out) <- "cl_validity" out } ## Package cluster: diana(). cl_validity.diana <- function(x, ...) { out <- list("Divisive coefficient" = x$dc) ## According to the docs, diana objects always have a diss ## component, but let's be defensive ... if(!is.null(d <- x$diss)) out <- c(out, cl_validity.default(x, d)) class(out) <- "cl_validity" out } ## Package clue: (virtual) class "cl_partition". cl_validity.cl_partition <- function(x, ...) cl_validity(.get_representation(x), ...) ## Package clue: class pclust. ## So that this works for all classes extending pclust ... cl_validity.pclust <- function(x, ...) x$validity print.cl_validity <- function(x, ...) { for(nm in names(x)) cat(nm, ": ", x[[nm]], "\n", sep = "") invisible(x) } .cl_validity_partition_d_a_f <- function(m, d) { ## "Dissimilarity accounted for". ## Internal function for computing 1 - a / mean(d), where the ## "average within dissimilarity" a is given by ## \frac{\sum_{i,j} \sum_k m_{ik}m_{jk} d(i,j)} ## {\sum_{i,j} \sum_k m_{ik}m_{jk}} ## where m is the membership matrix and d a *symmetric* matrix of ## dissimilarities. within_sums <- rowSums(sapply(seq_len(ncol(m)), function(k) { z <- m[, k] w <- outer(z, z) c(sum(w * d), sum(w)) })) average_within_d <- within_sums[1L] / within_sums[2L] 1 - average_within_d / mean(d) } .cl_validity_hierarchy_variance_a_f <- function(u, d) { ## *Variance accounted for*. ## See e.g. Hubert, Arabie, & Meulman (2006), The structural ## representation of proximity matrices with MATLAB: ## variance_accounted_for = ## 1 - \frac{\sum_{i < j} (d_{ij} - u_{ij}) ^ 2} ## {\sum_{i < j} (d_{ij} - mean(d)) ^ 2} ## As this can be arbitrarily negative, we cut at 0. max(1 - sum((d - u) ^ 2) / sum((d - mean(d)) ^ 2), 0) } .cl_validity_hierarchy_deviance_a_f <- function(u, d) { ## *Deviance accounted for* (i.e., absolute deviation). ## See e.g. Smith (2001), Constructing ultrametric and additive ## trees based on the ${L}_1$ norm, Journal of Classification. ## deviance_accounted_for = ## 1 - \frac{\sum_{i < j} |d_{ij} - u_{ij}|} ## {\sum_{i < j} |d_{ij} - median(d)|} ## As this can be arbitrarily negative, we cut at 0. max(1 - sum(abs(d - u)) / sum(abs(d - median(d))), 0) } ## Silhouette methods silhouette.cl_partition <- function(x, ...) silhouette(.get_representation(x), ...) silhouette.cl_pclust <- function(x, ...) x$silhouette clue/R/bag.R0000644000175100001440000000276711304023136012302 0ustar hornikuserscl_bag <- function(x, B, k = NULL, algorithm = "kmeans", parameters = NULL, method = "DFBC1", control = NULL) { ## Currently, method 'DFBC1' (Dudoit-Fridlyand BagClust1) is the ## only one available, and argument 'control' is ignored. ## Construct reference partition. algorithm <- match.fun(algorithm) reference <- eval(as.call(c(list(algorithm, x), if(!is.null(k)) list(k), parameters))) ## Construct bootstrap ensemble. clusterings <- cl_boot(x, B, k, algorithm, parameters, resample = TRUE) ## Construct Dudoit-Fridlyand BagClust1 consensus partitions, ## suitably generalized ... ## ## In principle, this could be turned into a "constructive" method ## for cl_consensus(), also allowing for weights (straightforward). ## E.g., ## .cl_consensus_partition_DFBC1(clusterings, weights, control) ## where either 'control specifies a reference partition, or the ## first element of 'clusterings' is taken as such. ## k <- max(sapply(c(clusterings, reference), n_of_classes)) M_ref <- cl_membership(reference, k) M <- matrix(0, NROW(M_ref), k) for(b in seq_len(B)) { mem <- cl_membership(clusterings[[b]], k) ## Match classes to reference partition. ind <- solve_LSAP(crossprod(M_ref, mem), maximum = TRUE) M <- M + mem[, ind] } as.cl_partition(cl_membership(as.cl_membership(M / B), k)) } clue/R/objects.R0000644000175100001440000001310113036461743013200 0ustar hornikusers### * n_of_objects ## Get the number of objects in a clustering. n_of_objects <- function(x) UseMethod("n_of_objects") ### ** Default method. n_of_objects.default <- function(x) length(cl_class_ids(x)) ## (Note that prior to R 2.1.0, kmeans() returned unclassed results, ## hence the best we can do for the *default* method is to look at a ## possibly existing "cluster" component. Using the class ids incurs ## another round of method dispatch, but avoids code duplication.) ### ** Partitioning methods. ## Package stats: kmeans() (R 2.1.0 or better). n_of_objects.kmeans <- n_of_objects.default ## Package cluster: clara(), fanny(), and pam() give objects of the ## respective class inheriting from class "partition". n_of_objects.partition <- n_of_objects.default ## Package cclust: cclust(). n_of_objects.cclust <- n_of_objects.default ## Package e1071: cmeans() gives objects of class "fclust". n_of_objects.fclust <- function(x) nrow(x$membership) ## Package e1071: cshell(). n_of_objects.cshell <- n_of_objects.fclust ## Package e1071: bclust(). n_of_objects.bclust <- n_of_objects.default ## Package mclust: Mclust(). n_of_objects.Mclust <- n_of_objects.default ### ** Hierarchical methods. ## Package stats: hclust(). n_of_objects.hclust <- function(x) length(x$order) ## Package cluster: agnes() and diana() give objects inheriting from ## class "twins". n_of_objects.twins <- n_of_objects.hclust ## Package cluster: mona(). n_of_objects.mona <- n_of_objects.hclust ## Package ape: class "phylo". n_of_objects.phylo <- function(x) length(x$tip.label) ### ** Others. ## Package stats: class "dist". n_of_objects.dist <- function(x) attr(x, "Size") ## Package clue: Ensembles. n_of_objects.cl_ensemble <- function(x) attr(x, "n_of_objects") ## Package clue: Memberships. n_of_objects.cl_membership <- nrow ## Package clue: pclust(). n_of_objects.pclust <- n_of_objects.default ## Package clue: Ultrametrics. n_of_objects.cl_ultrametric <- n_of_objects.dist ## Package clue: (virtual) class "cl_partition". n_of_objects.cl_partition <- function(x) .get_property_from_object_or_representation(x, "n_of_objects") ## Package clue: (virtual) class "cl_hierarchy". n_of_objects.cl_hierarchy <- function(x) .get_property_from_object_or_representation(x, "n_of_objects") ### * cl_object_names ## Determine the names of the objects in a clustering if available; give ## NULL otherwise. This is in sync with e.g. names() or dimnames(); au ## contraire, cl_object_labels() always gives labels even if no names ## are available. cl_object_names <- function(x) UseMethod("cl_object_names") ## ** Default method. cl_object_names.default <- function(x) names(cl_class_ids(x)) ## ** Partitions. ## There is really nothing special we can currently do. ## Most partitioning functions return no information on object names. ## This includes classes ## stats: kmeans ## cba: ccfkms, rock ## cclust: cclust ## e1071: bclust ## flexclust: kcca ## kernlab: specc ## mclust: Mclust ## The algorithms for which things "work" all give named class ids. ## RWeka: Weka_clusterer ## cluster: clara fanny pam ## e1071: cclust cshell ## ** Hierarchies. ## Package stats: hclust(). cl_object_names.hclust <- function(x) x$labels ## Package cluster: agnes(), diana() and mona() all return an object ## which has an 'order.lab' component iff "the original observations ## were labelled". We can use this together the the 'order' component ## to recreate the labels in their original order. Note that we cannot ## rely on dissimilarity or data components being available. cl_object_names.twins <- function(x) { if(!is.null(x$order.lab)) { out <- character(length = n_of_objects(x)) out[x$order] <- x$order.lab out } else NULL } cl_object_names.mona <- cl_object_names.twins ## Package ape: class "phylo". cl_object_names.phylo <- function(x) x$tip.label ## ** Others. ## Package stats: class "dist". ## (Raw object dissimilarities.) cl_object_names.dist <- function(x) attr(x, "Labels") ## Package clue: memberships. cl_object_names.cl_membership <- function(x) rownames(x) ## Package clue: ultrametrics. cl_object_names.cl_ultrametric <- function(x) attr(x, "Labels") ## Package clue: (virtual) class "cl_partition". cl_object_names.cl_partition <- function(x) cl_object_names(.get_representation(x)) ## Package clue: (virtual) class "cl_hierarchy". cl_object_names.cl_hierarchy <- function(x) cl_object_names(.get_representation(x)) ## Package clue: ensembles. cl_object_names.cl_ensemble <- function(x) { nms <- lapply(x, cl_object_names) ind <- which(lengths(nms) > 0L) if(any(ind)) nms[[ind[1L]]] else NULL } ### * cl_object_labels cl_object_labels <- function(x) { if(is.null(out <- cl_object_names(x))) out <- as.character(seq_len(n_of_objects(x))) out } ### * cl_object_dissimilarities ## Extract object dissimilarities from R objects containing such: this ## includes objects directly inheriting from "dist" as well as ## dendrograms or additive trees. cl_object_dissimilarities <- function(x) { ## Keep this in sync with .has_object_dissimilarities(). if(is.cl_dendrogram(x)) cl_ultrametric(x) else if(inherits(x, "dist")) x else stop("Cannot extract object dissimilarities") } .has_object_dissimilarities <- function(x) { ## Keep this in sync with cl_object_dissimilarities(). is.cl_dendrogram(x) || inherits(x, "dist") } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/addtree.R0000644000175100001440000003111014144530664013157 0ustar hornikusers### * ls_fit_addtree ls_fit_addtree <- function(x, method = c("SUMT", "IP", "IR"), weights = 1, control = list()) { if(!inherits(x, "dist")) x <- as.dist(x) ## Catch some special cases right away. if(attr(x, "Size") <= 3L) return(as.cl_addtree(x)) if(.non_additivity(x, max = TRUE) == 0) return(as.cl_addtree(x)) ## Handle argument 'weights'. ## This is somewhat tricky ... if(is.matrix(weights)) { weights <- as.dist(weights) if(length(weights) != length(x)) stop("Argument 'weights' must be compatible with 'x'.") } else weights <- rep_len(weights, length(x)) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") method <- match.arg(method) switch(method, SUMT = .ls_fit_addtree_by_SUMT(x, weights, control), IP = { .ls_fit_addtree_by_iterative_projection(x, weights, control) }, IR = { .ls_fit_addtree_by_iterative_reduction(x, weights, control) }) } ### ** .ls_fit_addtree_by_SUMT .ls_fit_addtree_by_SUMT <- function(x, weights = 1, control = list()) { ## Control parameters: ## gradient, gradient <- control$gradient if(is.null(gradient)) gradient <- TRUE ## nruns, nruns <- control$nruns ## start, start <- control$start ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } w <- weights / sum(weights) n <- attr(x, "Size") labels <- attr(x, "Labels") ## Handle missing values in x along the lines of de Soete (1984): ## set the corresponding weights to 0, and impute by the weighted ## mean. ind <- which(is.na(x)) if(any(ind)) { w[ind] <- 0 x[ind] <- weighted.mean(x, w, na.rm = TRUE) } L <- function(d) sum(w * (d - x) ^ 2) P <- .make_penalty_function_addtree(n) if(gradient) { grad_L <- function(d) 2 * w * (d - x) grad_P <- .make_penalty_gradient_addtree(n) } else { grad_L <- grad_P <- NULL } if(is.null(start)) { ## Initialize by "random shaking". Use sd() for simplicity. start <- replicate(nruns, x + rnorm(length(x), sd = sd(x) / sqrt(3)), simplify = FALSE) } ## And now ... d <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control))$x ## Round to enforce additivity, and hope for the best ... .cl_addtree_from_addtree_approximation(d, n, labels) } .make_penalty_function_addtree <- function(n) function(d) { (.non_additivity(.symmetric_matrix_from_veclh(d, n)) + sum(pmin(d, 0) ^ 2)) } .make_penalty_gradient_addtree <- function(n) function(d) { gr <- matrix(.C(C_deviation_from_additivity_gradient, as.double(.symmetric_matrix_from_veclh(d, n)), as.integer(n), gr = double(n * n))$gr, n, n) gr[row(gr) > col(gr)] + 2 * sum(pmin(d, 0)) } ### ** .ls_fit_addtree_by_iterative_projection ## ## Functions ## .ls_fit_addtree_by_iterative_projection() ## .ls_fit_addtree_by_iterative_reduction() ## are really identical apart from the name of the C routine they call. ## (But will this necessarily always be the case in the future?) ## Merge maybe ... ## .ls_fit_addtree_by_iterative_projection <- function(x, weights = 1, control = list()) { if(any(diff(weights))) warning("Non-identical weights currently not supported.") labels <- attr(x, "Labels") x <- as.matrix(x) n <- nrow(x) ## Control parameters: ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 10000L ## nruns, nruns <- control$nruns ## order, order <- control$order ## tol, tol <- control$tol if(is.null(tol)) tol <- 1e-8 ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle order and nruns. if(!is.null(order)) { if(!is.list(order)) order <- as.list(order) if(!all(vapply(order, function(o) all(sort(o) == seq_len(n)), NA))) stop("All given orders must be valid permutations.") } else { if(is.null(nruns)) nruns <- 1L order <- replicate(nruns, sample(n), simplify = FALSE) } ind <- lower.tri(x) L <- function(d) sum(weights * (x - d)[ind] ^ 2) d_opt <- NULL v_opt <- Inf for(run in seq_along(order)) { if(verbose) message(gettextf("Iterative projection run: %d", run)) d <- .C(C_ls_fit_addtree_by_iterative_projection, as.double(x), as.integer(n), as.integer(order[[run]] - 1L), as.integer(maxiter), iter = integer(1L), as.double(tol), as.logical(verbose))[[1L]] v <- L(d) if(v < v_opt) { v_opt <- v d_opt <- d } } d <- matrix(d_opt, n) dimnames(d) <- list(labels, labels) .cl_addtree_from_addtree_approximation(as.dist(d)) } ### ** .ls_fit_addtree_by_iterative_reduction .ls_fit_addtree_by_iterative_reduction <- function(x, weights = 1, control = list()) { if(any(diff(weights))) warning("Non-identical weights currently not supported.") labels <- attr(x, "Labels") x <- as.matrix(x) n <- nrow(x) ## Control parameters: ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 10000L ## nruns, nruns <- control$nruns ## order, order <- control$order ## tol, tol <- control$tol if(is.null(tol)) tol <- 1e-8 ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle order and nruns. if(!is.null(order)) { if(!is.list(order)) order <- as.list(order) if(!all(vapply(order, function(o) all(sort(o) == seq_len(n)), NA))) stop("All given orders must be valid permutations.") } else { if(is.null(nruns)) nruns <- 1L order <- replicate(nruns, sample(n), simplify = FALSE) } ind <- lower.tri(x) L <- function(d) sum(weights * (x - d)[ind] ^ 2) d_opt <- NULL v_opt <- Inf for(run in seq_along(order)) { if(verbose) message(gettextf("Iterative reduction run: %d", run)) d <- .C(C_ls_fit_addtree_by_iterative_reduction, as.double(x), as.integer(n), as.integer(order[[run]] - 1L), as.integer(maxiter), iter = integer(1L), as.double(tol), as.logical(verbose))[[1L]] v <- L(d) if(v < v_opt) { v_opt <- v d_opt <- d } } d <- matrix(d_opt, n) dimnames(d) <- list(labels, labels) .cl_addtree_from_addtree_approximation(as.dist(d)) } ### * .non_additivity .non_additivity <- function(x, max = FALSE) { if(!is.matrix(x)) x <- .symmetric_matrix_from_veclh(x) .C(C_deviation_from_additivity, as.double(x), as.integer(nrow(x)), fn = double(1L), as.logical(max))$fn } ### * ls_fit_centroid ls_fit_centroid <- function(x) { ## Fit a centroid additive tree distance along the lines of Carroll ## & Pruzansky (1980). In fact, solving ## ## \sum_{i,j: i \ne j} (\delta_{ij} - (g_i + g_j)) ^ 2 => min_g ## ## gives \sum_{j: j \ne i} (g_i + g_j - \delta_{ij}) = 0, or (also ## in Barthemely & Guenoche) ## ## (n - 2) g_i + \sum_j g_j = \sum_{j: j \ne i} \delta_{ij} ## ## which after summing over all i and some manipulations eventually ## gives ## ## g_i = \frac{1}{n-2} (v_i - m), ## ## v_i = \sum_{j: j \ne i} \delta_{ij} ## s = \frac{1}{2(n-1)} \sum_{i,j: j \ne i} \delta_{ij} n <- attr(x, "Size") if(n <= 2L) return(as.cl_addtree(0 * x)) x <- as.matrix(x) g <- rowSums(x) / (n - 2) - sum(x) / (2 * (n - 1) * (n - 2)) as.cl_addtree(as.dist(.make_centroid_matrix(g))) } .make_centroid_matrix <- function(g) { y <- outer(g, g, `+`) diag(y) <- 0 y } ### * as.cl_addtree as.cl_addtree <- function(x) UseMethod("as.cl_addtree") as.cl_addtree.default <- function(x) { if(inherits(x, "cl_addtree")) x else if(is.atomic(x) || inherits(x, "cl_ultrametric")) .cl_addtree_from_veclh(x) else if(is.matrix(x)) { ## Should actually check whether the matrix is symmetric, >= 0 ## and satisfies the 4-point conditions ... .cl_addtree_from_veclh(as.dist(x)) } else if(is.cl_dendrogram(x)) .cl_addtree_from_veclh(cl_ultrametric(x)) else stop("Cannot coerce to 'cl_addtree'.") } as.cl_addtree.phylo <- function(x) .cl_addtree_from_veclh(as.dist(cophenetic(x))) ## Phylogenetic trees with edge/branch lengths yield additive tree ## dissimilarities. ### * .cl_addtree_from_veclh .cl_addtree_from_veclh <- function(x, size = NULL, labels = NULL) { cl_proximity(x, "Additive tree distances", labels = labels, size = size, class = c("cl_addtree", "cl_dissimilarity", "cl_proximity", "dist")) } ### * .cl_addtree_from_addtree_approximation .cl_addtree_from_addtree_approximation <- function(x, size = NULL, labels = NULL) { ## Turn x into an addtree after possibly rounding to non-additivity ## significance (note that this is not guaranteed to work ...). mnum <- .non_additivity(x, max = TRUE) x <- round(x, floor(abs(log10(mnum)))) .cl_addtree_from_veclh(x, size = size, labels = labels) } ### * .decompose_addtree .decompose_addtree <- function(x, const = NULL) { ## Decompose an addtree into an ultrametric and a centroid ## distance. ## If 'const' is not given, we take the root as half way between the ## diameter of the addtree, and choose a minimal constant to ensure ## non-negativity (but not positivity) of the ultrametric. ## As this is all slightly dubious and it is not quite clear how ## much positivity we want in the ultrametric of the decomposition, ## we keep this hidden. For plotting addtrees, the choice of the ## constant does not seem to matter. x <- as.matrix(x) n <- nrow(x) ## Determine diameter. ind <- which.max(x) - 1 u <- ind %% n + 1 v <- ind %/% n + 1 if(!is.null(const)) g <- pmax(x[u, ], x[v, ]) - const else { g <- pmax(x[u, ], x[v, ]) - x[u, v] / 2 u <- x - .make_centroid_matrix(g) k <- - min(u) g <- g - k / 2 } u <- x - .make_centroid_matrix(g) names(g) <- rownames(x) ## Ensure a valid ultrametric. d <- .ultrametrify(as.dist(u)) u <- .cl_ultrametric_from_veclh(d, nrow(x), rownames(x)) ## Note that we return the centroid distances to the root, and not ## between the objects (as.dist(.make_centroid_matrix(g))) ... list(Ultrametric = as.cl_ultrametric(u), Centroid = g) } ### * plot.cl_addtree plot.cl_addtree <- function(x, ...) { ## Construct a dendrogram-style representation of the addtree with ## the root half way between the diameter, and plot. y <- .decompose_addtree(x, max(x)) u <- y$Ultrametric g <- y$Centroid ## We halve the scale of the ultrametric, and add the maximal g from ## the centroid. h <- hclust(as.dist(u / 2), "single") h$height <- h$height + max(g) d <- as.dendrogram(h) ## Now modify the heights of the leaves so that the objects giving ## the diameter of the addtree end up with height zero. g <- max(g) - g names(g) <- labels(g) d <- dendrapply(d, function(n) { if(!is.leaf(n)) return(n) attr(n, "height") <- g[attr(n, "label")] n }) ## And finally plot plot(d, ...) } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/tabulate.R0000644000175100001440000000061411304023136013337 0ustar hornikuserscl_tabulate <- function(x) { values <- unique(x) counts <- tabulate(match(x, values)) ## Still a bit tricky to create a data frame with a list "column" ## which is not protected by I(); otherwise, we oculd simply do ## data.frame(values = I(values), counts = counts) out <- data.frame(values = double(length(values)), counts = counts) out$values <- values out } clue/R/dissimilarity.R0000644000175100001440000004506114335746635014460 0ustar hornikusers### * cl_dissimilarity cl_dissimilarity <- function(x, y = NULL, method = "euclidean", ...) { x <- as.cl_ensemble(x) is_partition_ensemble <- (inherits(x, "cl_partition_ensemble") || all(vapply(x, .has_object_memberships, NA))) ## Be nice. if(is.character(y) || is.function(y)) { method <- y y <- NULL } if(is.function(method)) method_name <- "user-defined method" else { if(!inherits(method, "cl_dissimilarity_method")) { ## Get the method definition and description from the ## registry. type <- ifelse(is_partition_ensemble, "partition", "hierarchy") method <- get_cl_dissimilarity_method(method, type) } method_name <- method$description method <- method$definition } if(!is.null(y)) { y <- as.cl_ensemble(y) is_partition_ensemble_y <- (inherits(y, "cl_partition_ensemble") || all(vapply(x, .has_object_memberships, NA))) if(!identical(is_partition_ensemble, is_partition_ensemble_y)) stop("Cannot mix partitions and hierarchies.") if(n_of_objects(x) != n_of_objects(y)) stop("All clusterings must have the same number of objects.") ## Build a cross-proximity object of cross-dissimilarities. d <- matrix(0, length(x), length(y)) for(j in seq_along(y)) d[, j] <- sapply(x, method, y[[j]], ...) dimnames(d) <- list(names(x), names(y)) return(cl_cross_proximity(d, method_name, class = "cl_cross_dissimilarity")) } ## Otherwise, build a proximity object of dissimilarities. n <- length(x) d <- vector("list", length = n - 1L) ind <- seq_len(n) while(length(ind) > 1L) { j <- ind[1L] ind <- ind[-1L] d[[j]] <- sapply(x[ind], method, x[[j]], ...) } cl_proximity(unlist(d), method_name, labels = names(x), size = n, class = c("cl_dissimilarity", "cl_proximity", "dist")) } ### ** .cl_dissimilarity_partition_euclidean .cl_dissimilarity_partition_euclidean <- function(x, y) { k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) ## Match classes from conforming memberships. ind <- solve_LSAP(crossprod(M_x, M_y), maximum = TRUE) sqrt(sum((M_x - M_y[, ind]) ^ 2)) } ### ### ** .cl_dissimilarity_partition_manhattan .cl_dissimilarity_partition_manhattan <- function(x, y) { k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) C <- .cxdist(M_x, M_y, "manhattan") ind <- solve_LSAP(C) sum(C[cbind(seq_along(ind), ind)]) } ### ** .cl_dissimilarity_partition_comemberships .cl_dissimilarity_partition_comemberships <- function(x, y) { ## We used to have the straightforward ## C_x <- tcrossprod(cl_membership(x)) # M_x M_x' ## C_y <- tcrossprod(cl_membership(y)) # M_y M_y' ## sum((C_x - C_y) ^ 2) / n_of_objects(x) ^ 2 ## But note that ## \| AA' - BB' \|^2 ## = tr((AA' - BB')'(AA' - BB') ## = tr(A'A A'A) - 2 tr(A'B B'A) + tr(B'B B'B) ## = \| A'A \|^2 - 2 \| A'B \|^2 + \| B'B \|^2 ## which can be computed much more efficiently as all involved cross ## product matrices are "small" ... k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) sqrt(sum(crossprod(M_x) ^ 2) - 2 * sum(crossprod(M_x, M_y) ^ 2) + sum(crossprod(M_y) ^ 2)) } ### ** .cl_dissimilarity_partition_symdiff .cl_dissimilarity_partition_symdiff <- function(x, y) { ## Cardinality of the symmetric difference of the partitions ## regarded as binary equivalence relations, i.e., the number of ## discordant pairs. ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) n <- n_of_objects(x) .cl_dissimilarity_partition_Rand(x, y) * choose(n, 2) } ### ** .cl_dissimilarity_partition_Rand .cl_dissimilarity_partition_Rand <- function(x, y) { ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) 1 - .cl_agreement_partition_Rand(x, y) } ### ** .cl_dissimilarity_partition_GV1 .cl_dissimilarity_partition_GV1 <- function(x, y) { k_x <- n_of_classes(x) k_y <- n_of_classes(y) M_x <- cl_membership(x, k_x) M_y <- cl_membership(y, k_y) C <- outer(colSums(M_x ^ 2), colSums(M_y ^ 2), `+`) - 2 * crossprod(M_x, M_y) if(k_x < k_y) C <- rbind(C, matrix(0, nrow = k_y - k_x, ncol = k_y)) else if(k_x > k_y) C <- cbind(C, matrix(0, nrow = k_x, ncol = k_x - k_y)) ind <- solve_LSAP(C) sqrt(sum(C[cbind(seq_along(ind), ind)])) ## (Note that this sum really only includes matched non-dummy ## classes.) } ### ** .cl_dissimilarity_partition_BA_A .cl_dissimilarity_partition_BA_A <- function(x, y) { .cl_dissimilarity_partition_manhattan(as.cl_hard_partition(x), as.cl_hard_partition(y)) / 2 ## Could to this more efficiently, of course ... } ### ** .cl_dissimilarity_partition_BA_C .cl_dissimilarity_partition_BA_C <- function(x, y) { n_of_classes(x) + n_of_classes(y) - 2 * n_of_classes(cl_join(x, y)) } ### ** .cl_dissimilarity_partition_BA_D .cl_dissimilarity_partition_BA_D <- .cl_dissimilarity_partition_Rand ### ** .cl_dissimilarity_partition_BA_E .cl_dissimilarity_partition_BA_E <- function(x, y) { z <- table(cl_class_ids(x), cl_class_ids(y)) z <- z / sum(z) ## Average mutual information between the partitions. y <- outer(rowSums(z), colSums(z)) i <- which((z > 0) & (y > 0)) I <- sum(z[i] * log(z[i] / y[i])) ## Entropy of meet(x, y). i <- which(z > 0) H <- - sum(z[i] * log(z[i])) 1 - I / H } ### ** .cl_dissimilarity_partition_VI .cl_dissimilarity_partition_VI <- function(x, y, weights = 1) { ## Variation of information for general "soft clusterings", cf ## Section 5.2. in Meila (2002). weights <- rep_len(weights, n_of_objects(x)) weights <- weights / sum(weights) M_x <- cl_membership(x) ## Weighted marginal distribution of x: m_x <- colSums(weights * M_x) M_y <- cl_membership(y) ## Weighted marginal distribution of y: m_y <- colSums(weights * M_y) gamma <- crossprod(weights * M_x, M_y) delta <- outer(m_x, m_y) ## Entropy of x: H_x <- - sum(m_x * log(ifelse(m_x > 0, m_x, 1))) ## Entropy of y: H_y <- - sum(m_y * log(ifelse(m_y > 0, m_y, 1))) ## VI is H_x + H_y minus twice the (weighted) joint information. i <- which((gamma > 0) & (delta > 0)) H_x + H_y - 2 * sum(gamma[i] * log(gamma[i] / delta[i])) } ### ** .cl_dissimilarity_partition_Mallows .cl_dissimilarity_partition_Mallows <- function(x, y, p = 1, alpha = NULL, beta = NULL) { ## Currently, no "real" primal-dual solver for minimum cost flow ## problems, and lpSolve::lp.transport() seems to work only for ## integer bounds. Hence, rather than using ## ## C <- .cxdist(cl_membership(x), cl_membership(y), ## "minkowski", p) ^ p ## n_x <- nrow(C) ## n_y <- ncol(C) ## if(is.null(alpha)) ## alpha <- rep.int(1 / n_x, n_x) ## else { ## alpha <- rep_len(alpha, n_x) ## alpha <- alpha / sum(alpha) ## } ## ## etc right away, ensure a square cost matrix so that we can have ## integer bounds for at least the default case. k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) C <- .cxdist(M_x, M_y, "minkowski", p) ^ p if(is.null(alpha)) alpha <- rep.int(1, k) if(is.null(beta)) beta <- rep.int(1, k) lpSolve::lp.transport(C, "min", rep.int("==", k), alpha, rep.int("==", k), beta, integers = NULL)$objval ^ (1 / p) } ### ** .cl_dissimilarity_partition_CSSD .cl_dissimilarity_partition_CSSD <- function(x, y, L = NULL, alpha = NULL, beta = NULL, ...) { ## Cluster Similarity Sensitive Distance. ## Reference: D. Zhou, J. Li and H. Zha (2005), ## A new Mallows distance based metric for comparing clusterings. ## See .cl_dissimilarity_partition_Mallows() re solving cost flow ## problems. ## Dissimilarity is defined by minimizing ## \sum_{k,l} (1 - 2 w_{kl} / (alpha_k + beta_l)) L_{kl} ## where ## L_{kl} = \sum_i m_{x;ik} m_{y;il} distance(p_{x;k}, p_{y;l}) ## with m and p the memberships and prototypes, respectively. ## If we get matrices of prototypes, use .rxdist; otherwise, the ## user needs to specify an L function or matrix. k_x <- n_of_classes(x) k_y <- n_of_classes(y) M_x <- cl_membership(x, k_x) M_y <- cl_membership(y, k_y) if(!is.matrix(L)) { p_x <- cl_prototypes(x) p_y <- cl_prototypes(y) if(is.matrix(p_x) && is.matrix(p_y) && is.null(L)) L <- .rxdist(p_x, p_y, ...) else if(is.function(L)) L <- L(p_x, p_y) else stop("Cannot compute prototype distances.") } C <- crossprod(M_x, M_y) * L if(is.null(alpha)) alpha <- rep.int(1, k_x) if(is.null(beta)) beta <- rep.int(1, k_y) sum(C) - 2 * lpSolve::lp.transport(C / outer(alpha, beta, `+`), "max", rep.int("==", k_x), alpha, rep.int("==", k_y), beta, integers = NULL)$objval } ### ** .cl_dissimilarity_hierarchy_euclidean .cl_dissimilarity_hierarchy_euclidean <- function(x, y, weights = 1) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) sqrt(sum(weights * (u - v) ^ 2)) } ### ** .cl_dissimilarity_hierarchy_manhattan .cl_dissimilarity_hierarchy_manhattan <- function(x, y, weights = 1) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) sum(weights * abs(u - v)) } ### ** .cl_dissimilarity_hierarchy_cophenetic .cl_dissimilarity_hierarchy_cophenetic <- function(x, y) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) 1 - cor(u, v) ^ 2 } ### ** .cl_dissimilarity_hierarchy_gamma .cl_dissimilarity_hierarchy_gamma <- function(x, y) { ## ## This is a dissimilarity measure that works for arbitrary ## dissimilarities, see e.g. Bock. ## (And the current implementation finally respects this ...) ## if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) n <- length(u) .C(C_clue_dissimilarity_count_inversions, as.double(u), as.double(v), as.integer(n), count = double(1L)) $ count / choose(n, 2) } ### ** .cl_dissimilarity_hierarchy_symdiff .cl_dissimilarity_hierarchy_symdiff <- function(x, y) { ## Cardinality of the symmetric difference of the n-trees when ## regarded as sets of subsets (classes) of the set of objects. x <- cl_classes(x) y <- cl_classes(y) sum(is.na(match(x, y))) + sum(is.na(match(y, x))) } ### ** .cl_dissimilarity_hierarchy_Chebyshev .cl_dissimilarity_hierarchy_Chebyshev <- function(x, y) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) max(abs(u - v)) } ### ** .cl_dissimilarity_hierarchy_Lyapunov .cl_dissimilarity_hierarchy_Lyapunov <- function(x, y) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) q <- cl_object_dissimilarities(x) / cl_object_dissimilarities(y) if(is.matrix(q)) q <- q[lower.tri(q)] log(max(q) / min(q)) } ### ** .cl_dissimilarity_hierarchy_BO .cl_dissimilarity_hierarchy_BO <- function(x, y, delta, ...) { ## Compute Boorman-Olivier (1973) dendrogram ("valued tree") ## dissimilarities of the form ## ## m_\delta(T_1, T_2) ## = \int_0^\infty \delta(P_1(\alpha), P_2(\alpha)) d\alpha ## ## where the trees (dendrograms) are defined as right-continuous ## maps from [0, \Infty) to the partition lattice. ## We can compute this as follows. Take the ultrametrics and use ## as.hclust() to detemine the heights \alpha_1(k) and \alpha_2(l) ## of the splits. Let \alpha_i be the sequence obtained by ## combining these two. Then ## ## m_\delta ## = \sum_{i=0}^{L-1} (\alpha_{i+1} - \alpha_i) ## \delta(P_1(\alpha_i), P_2(\alpha_i)) ## ## We use cutree() for computing the latter partitions. As we ## already have the hclust representations, we should be able to do ## things more efficiently ... if(inherits(x, "hclust")) t_x <- x else if(inherits(x, "cl_ultrametric")) t_x <- as.hclust(x) else if(is.cl_dendrogram(x)) t_x <- as.hclust(cl_ultrametric(x)) else return(NA) if(inherits(y, "hclust")) t_y <- y else if(inherits(y, "cl_ultrametric")) t_y <- as.hclust(y) else if(is.cl_dendrogram(y)) t_y <- as.hclust(cl_ultrametric(y)) else return(NA) if(is.unsorted(t_x$height) || is.unsorted(t_y$height)) return(NA) alpha <- sort(unique(c(t_x$height, t_y$height))) cuts_x <- cutree(t_x, h = alpha) cuts_y <- cutree(t_y, h = alpha) deltas <- mapply(cl_dissimilarity, lapply(split(cuts_x, col(cuts_x)), as.cl_partition), lapply(split(cuts_y, col(cuts_y)), as.cl_partition), MoreArgs = list(delta, ...)) sum(diff(alpha) * deltas[-length(deltas)]) } ### ** .cl_dissimilarity_hierarchy_spectral .cl_dissimilarity_hierarchy_spectral <- function(x, y) { if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u <- cl_object_dissimilarities(x) v <- cl_object_dissimilarities(y) svd(as.matrix(u - v))$d[1L] } ### * as.dist.cl_dissimilarity as.dist.cl_dissimilarity <- function(m, diag = FALSE, upper = FALSE) { y <- c(m) ## Fill non-inherited attributes with default values. attributes(y) <- c(attributes(m)[c("Size", "Labels")], Diag = diag, Upper = upper, call = match.call()) ## (Note that as.dist.default() does not automatically add ## 'method'.) class(y) <- "dist" y } ### * [.cl_dissimilarity "[.cl_dissimilarity" <- function(x, i, j) { y <- NextMethod("[") if(!inherits(y, "cl_dissimilarity")) { description <- attr(x, "description") return(cl_cross_proximity(y, description = description, class = "cl_cross_dissimilarity")) } y } ### .cxdist .cxdist <- function(A, B, method = c("euclidean", "manhattan", "minkowski"), ...) { ## Return the column cross distance matrix of A and B. ## I.e., the matrix C = [c_{j,k}] with ## c_{j,k} = distance(A[, j], B[, k]) ## Currently, only Manhattan (L1) distances are provided. ## Extensions to Minkowski or even more distances (a la dist()) ## could be added eventually. ## ## Possible implementations include ## ## foo_a <- function(A, B) ## apply(B, 2, function(u) colSums(abs(A - u))) ## foo_d <- function(A, B) { ## out <- as.matrix(dist(rbind(t(A), t(B)), "manhattan")) ## dimnames(out) <- NULL ## nc_B <- NCOL(B) ## out[seq(from = NCOL(A) + 1, length.out = nc_B), seq_len(nc_B)] ## } ## foo_f <- function(A, B) { ## out <- matrix(0, NCOL(A), NCOL(B)) ## for(j in seq_len(NCOL(A))) ## for(k in seq_len(NCOL(B))) ## out[j, k] = sum(abs(A[, j] - B[, k])) ## out ## } ## ## The one actually used seems to be the best performer, with the ## "for" version a close second (note that "typically", A and B have ## much fewer columns than rows). ## only few columns method <- match.arg(method) ## Workhorse. FOO <- switch(method, "euclidean" = function(M) sqrt(colSums(M ^ 2)), "manhattan" = function(M) colSums(abs(M)), "minkowski" = { ## Power needs to be given. p <- list(...)[[1L]] function(M) (colSums(abs(M) ^ p)) ^ (1 / p) }) out <- matrix(0, NCOL(A), NCOL(B)) for(k in seq_len(NCOL(B))) out[, k] <- FOO(A - B[, k]) out } ### .rxdist .rxdist <- function(A, B, method = c("euclidean", "manhattan", "minkowski"), ...) { ## Return the row cross distance matrix of A and B. ## I.e., the matrix C = [c_{j,k}] with ## c_{j,k} = distance(A[j, ], B[k, ]) ## ## Could also do something like ## ind <- seq_len(NROW(B)) ## as.matrix(dist(rbind(B, A)))[-ind, ind] ## but that is *very* inefficient for the "usual" data by prototype ## case (where NROW(B) << NROW(A)). ## ## No fancy pmatching for methods for the time being. method <- match.arg(method) ## Workhorse: Full A, single row of b. FOO <- switch(method, "euclidean" = function(A, b) sqrt(rowSums(sweep(A, 2, b) ^ 2)), "manhattan" = function(A, b) rowSums(abs(sweep(A, 2, b))), "minkowski" = { ## Power needs to be given. p <- list(...)[[1L]] function(A, b) (rowSums(abs(sweep(A, 2, b)) ^ p)) ^ (1 / p) }) out <- matrix(0, NROW(A), NROW(B)) ## Be nice: thanks to Wael Salem ZRAFI for ## suggesting this improvement. if(!is.null(cnA <- colnames(A)) && !is.null(cnB <- colnames(B)) && !identical(cnA, cnB)) A <- A[, cnB, drop = FALSE] for(k in seq_len(NROW(B))) out[, k] <- FOO(A, B[k, ]) out } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/utilities.R0000644000175100001440000001015014144531004013550 0ustar hornikusers### * Matrix/vector utilities ### * .dist_from_vector .dist_from_vector <- function(x, n = NULL, labels = NULL) { ## This might be useful as as.dist.vector, perhaps without the extra ## argument n then which we only have for minimal performance gains. if(is.null(n)) n <- as.integer((sqrt(1 + 8 * length(x)) + 1) / 2) attr(x, "Size") <- n if(!is.null(labels)) attr(x, "Labels") <- labels class(x) <- "dist" x } ### ** .one_entry_per_column .one_entry_per_column <- function(x, j) { ## For a matrix x and a vector of column indices j_1, ..., j_n where ## n is the number of rows of x, get x[1,j_1], ..., x[n,j_n]. ## ## This used to have ## if(!is.matrix(x)) ## stop("Argument 'x' must be a matrix.") ## but that will fail for sparse matrix classes. ## So let us hope for the best ... ## x[cbind(seq_len(nrow(x)), j)] } ".one_entry_per_column<-" <- function(x, j, value) { ## ## This used to have ## if(!is.matrix(x)) ## stop("Argument 'x' must be a matrix.") ## but that will fail for sparse matrix classes. ## So let us hope for the best ... ## x[cbind(seq_len(nrow(x)), j)] <- value x } ### * .symmetric_matrix_from_veclh .symmetric_matrix_from_veclh <- function(x, n = NULL) { ## In essence the same as as.matrix.dist, but without handling the ## additional attributes that dist objects might have. if(is.null(n)) n <- as.integer((sqrt(1 + 8 * length(x)) + 1) / 2) M <- matrix(0, n, n) M[row(M) > col(M)] <- x M + t(M) } ### * .weighted_mean_of_object_dissimilarities .weighted_mean_of_object_dissimilarities <- function(x, w = NULL) { w <- if(is.null(w)) { rep.int(1, length(x)) } else { rep_len(w, length(x)) } ## (Need the latter because we want w / sum(w) ...) dissimilarities <- lapply(x, cl_object_dissimilarities) m <- rowSums(mapply(`*`, dissimilarities, w / sum(w))) labels <- attr(dissimilarities[[1L]], "Labels") .dist_from_vector(m, labels = labels) } ### ** .weighted_sum_of_matrices .weighted_sum_of_matrices <- function(x, w = NULL, nr = NULL) { ## Quite often we need to compute weighted sums \sum_b w_b X_b of ## conforming matrices \{ X_b \}. If x is a list containing the ## matrices and w the vector of weights, it seems that one ## reasonably efficient way of doing this is the following. if(is.null(w)) w <- rep.int(1, length(x)) if(is.null(nr)) nr <- NROW(x[[1L]]) matrix(rowSums(mapply(`*`, x, w)), nr) } ### ** .weighted_sum_of_vectors .weighted_sum_of_vectors <- function(x, w = NULL) { ## See above. if(is.null(w)) w <- rep.int(1, length(x)) rowSums(mapply(`*`, x, w)) } ### * Containers ## Creator. .make_container <- function(x, classes, properties = NULL) { out <- list(.Data = x, .Meta = properties) class(out) <- unique(classes) out } ## Getters. .get_representation <- function(x) x$.Data .get_properties <- function(x) x$.Meta .get_property <- function(x, which) x$.Meta[[which]] .has_property <- function(x, which) which %in% names(x$.Meta) .get_property_from_object_or_representation <- function(x, which, getter) { if(.has_property(x, which)) .get_property(x, which) else { if(missing(getter)) getter <- get(which) getter(.get_representation(x)) } } ## Methods (sort of). .print_container <- function(x, cls, ...) { writeLines(gettextf("An object of virtual class '%s', with representation:\n", cls)) print(.get_representation(x), ...) invisible(x) } ### * Others weighted_median <- function(x, w = 1, na.rm = FALSE) { w <- rep_len(w, length(x)) if(na.rm && any(ind <- is.na(x))) { x <- x[!ind] w <- w[!ind] } if(any(is.na(x)) || !length(x)) return(NA) w <- w / sum(w) ind <- order(x) x <- x[ind] w <- w[ind] x[which.min(x * (cumsum(w) - 0.5) - cumsum(w * x))] } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/predict.R0000644000175100001440000002453614503541710013210 0ustar hornikusers## ## Maybe add support for "auto" type (class_ids when predicting from a ## hard, memberships when predicting from a soft partition) eventually. ## cl_predict <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) UseMethod("cl_predict") ## Default method. ## Should also work for kcca() from package flexclust. cl_predict.default <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) .as_cl_class_ids_or_membership(predict(object, newdata, ...), type) ## Package stats: kmeans() (R 2.1.0 or better). cl_predict.kmeans <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) d <- .rxdist(newdata, object$centers) .as_cl_class_ids_or_membership(max.col(-d), type) } ## Package cluster: ## * fanny() cannot make "new" predictions. ## * clara() gives medoids, and takes metric data using Euclidean or ## Manhattan dissimilarities (and we can figure out which by looking ## at the call and the default values). ## * pam() gives medoids, but might have been called with dissimilarity ## data, so is tricky. We can always find out which by looking at the ## medoids: as in the dissimilarity input case this is a vector of ## class labels, and a matrix with in each row the coordinates of one ## medoid otherwise. We then still need to figure out whether ## Euclidean or Manhattan distances were used by looking at the call ## and the default values. ## Both pam() and clara() show that the interfaces could be improved to ## accomodate modern needs, e.g., for bagging. cl_predict.fanny <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) stop("Cannot make new predictions.") } cl_predict.clara <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) ## ## Add support eventually ... if(identical(object$call$stand, TRUE)) warning("Standardization is currently not supported.") ## method <- object$call$metric if(is.null(method)) { ## Not given in the call, hence use default value. method <- eval(formals(clara)$metric)[1L] ## (Or hard-wire the default value: "euclidean".) } d <- .rxdist(newdata, object$medoids, method) .as_cl_class_ids_or_membership(max.col(-d), type) } cl_predict.pam <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) prototypes <- object$medoids if(!is.matrix(prototypes)) stop("Cannot make new predictions.") ## ## Add support eventually ... if(identical(object$call$stand, TRUE)) warning("Standardization is currently not supported.") ## method <- object$call$metric if(is.null(method)) { ## Not given in the call, hence use default value. method <- eval(formals(pam)$metric)[1L] ## (Or hard-wire the default value: "euclidean".) } d <- .rxdist(newdata, object$medoids, method) .as_cl_class_ids_or_membership(max.col(-d), type) } ## Package RWeka: clusterers return objects inheriting from ## "Weka_clusterer". cl_predict.Weka_clusterer <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) .as_cl_class_ids_or_membership(predict(object, newdata = newdata, type = type, ...), type) } ## Package cba: ccfkms(). cl_predict.ccfkms <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) .as_cl_class_ids_or_membership(as.vector(predict(object, newdata)$cl), type) } ## Package cba: rockCluster() returns objects of class "rock". ## If x is a Rock object, fitted(x) and predict(x, newdata) can result ## in missing classifications, as ## In the case a 'drop' value greater than zero is specified, all ## clusters with size equal or less than this value are removed from ## the classifier. Especially, 'fitted' uses a threshold of one ## because for singleton clusters the neighborhood is empty. cl_predict.rock <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) newdata <- object$x ids <- as.vector(predict(object, newdata, ...)$cl) .as_cl_class_ids_or_membership(ids, type) } ## Package cclust: cclust(). cl_predict.cclust <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { ## Package cclust provides predict.cclust() which returns (again) an ## object of class "cclust", but does not give the labels of the ## original data in case no new data are given. if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) .as_cl_class_ids_or_membership(predict(object, newdata), type) } ## Package e1071: cmeans() gives objects of class "fclust". cl_predict.fclust <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) ## Note that the 'fclust' objects returned by cmeans() do not always ## directly contain the information on the fuzzification parameter m ## and the distance (Euclidean/Manhattan) employed, so we have to ## engineer this from the matched call and the default arguments. nms <- names(object$call) ## Note that we cannot directly use object$call$m, as this could ## give the 'method' argument if 'm' was not given. m <- if("m" %in% nms) object$call$m else { ## Not given in the call, hence use default value. formals(e1071::cmeans)$m ## (Or hard-wire the default value: 2.) } method <- if("dist" %in% nms) object$call$dist else { ## Not given in the call, hence use default value. formals(e1071::cmeans)$dist ## (Or hard-wire the default value: "euclidean".) } d <- .rxdist(newdata, object$centers, method) power <- c(m, if(method == "euclidean") 2 else 1) M <- .memberships_from_cross_dissimilarities(d, power) .as_cl_class_ids_or_membership(M, type) } ## Package e1071: cshell(). cl_predict.cshell <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) ## Not surprisingly, this is rather similar to what we do for fclust ## objects. Only dissimiliraties (and exponents) need to be ## computed differently ... nms <- names(object$call) m <- if("m" %in% nms) object$call$m else { ## Not given in the call, hence use default value. formals(e1071::cshell)$m ## (Or hard-wire the default value: 2.) } method <- if("dist" %in% nms) object$call$dist else { ## Not given in the call, hence use default value. formals(e1071::cshell)$dist ## (Or hard-wire the default value: "euclidean".) } d <- .rxdist(newdata, object$centers, method) d <- sweep(d, 2, object$radius) ^ 2 M <- .memberships_from_cross_dissimilarities(d, m) .as_cl_class_ids_or_membership(M, type) } ## Package e1071: bclust(). ## ## One might argue that it would be better to use the 'dist.method' ## employed for the hierarchical clustering, but it seems that class ## labels ("clusters") are always assigned using Euclidean distances. cl_predict.bclust <- cl_predict.kmeans ## ## Package flexclust: kcca() returns objects of S4 class "kcca" which ## extends S4 class "flexclust". cl_predict.kcca <- cl_predict.default ## Package flexmix: class "flexmix". cl_predict.flexmix <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) .as_cl_class_ids_or_membership(modeltools::posterior(object, newdata, ...), type) } ## Package mclust: Mclust(). cl_predict.Mclust <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) pred <- predict(object, newdata, ...) type <- match.arg(type) if(type == "class_ids") as.cl_class_ids(pred$classification) else as.cl_membership(pred$z) } ## Package movMF: movMF(). cl_predict.movMF <- cl_predict.Weka_clusterer ## Package clue: pclust(). cl_predict.pclust <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) { if(is.null(newdata)) return(.cl_class_ids_or_membership(object, type)) d <- object$family$D(newdata, object$prototypes) power <- c(object$m, object$family$e) M <- .memberships_from_cross_dissimilarities(d, power) .as_cl_class_ids_or_membership(M, type) } ## Package clue: (virtual) class "cl_partition". cl_predict.cl_partition <- function(object, newdata = NULL, type = c("class_ids", "memberships"), ...) cl_predict(.get_representation(object), newdata = newdata, type, ...) ## Internal helpers: this looks a bit silly, but makes the rest of the ## code look nicer ... .cl_class_ids_or_membership <- function(x, type = c("class_ids", "memberships")) { type <- match.arg(type) if(type == "class_ids") cl_class_ids(x) else cl_membership(x) } .as_cl_class_ids_or_membership <- function(x, type = c("class_ids", "memberships")) { type <- match.arg(type) if(type == "class_ids") { if(is.matrix(x)) { ## Same as for cl_class_ids.cl_membership(). as.cl_class_ids(.structure(max.col(x), names = rownames(x))) } else as.cl_class_ids(x) } else as.cl_membership(x) } clue/R/pava.R0000644000175100001440000000507013036461767012512 0ustar hornikusers## A Pool Adjacent Violators Algorithm framework for minimizing problems ## like ## ## \sum_i \sum_{J_i} w_{ij} f(y_{ij}, m_i) ## ## under the constraint m_1 <= ... <= m_n with f a convex function in m. ## Note that this formulation allows for repeated data in each block, ## and hence is more general than the usual pava/isoreg ones. A solver ## for the unconstrained \sum_k w_k f(y_k, m) => min! is needed. ## Typical cases are f(y, m) = |y - m|^p for p = 2 (solved by weighted ## mean) and p = 1 (solved by weighted median), respectively. ## A general design issue is whether weights should be supported or not, ## because in the latter case the solver could be a function of a single ## (data) argument only. Let's assume the former for the time being. pava <- function(x, w = NULL, solver = weighted.mean, merger = c) { n <- length(x) if(is.null(w)) { w <- if(is.list(x)) lapply(lengths(x), function(u) rep.int(1, u)) else rep.int(1, n) } else if(is.list(x)) w <- as.list(w) inds <- as.list(seq_len(n)) vals <- mapply(solver, x, w) ## Combine blocks i and i + 1. combine <- if(is.list(x)) { ## In the repeated data case, we explicitly merge the data (and ## weight) lists. function(i) { ## Merge the data and indices, solve, and put things back ## into position i, dropping position i + 1. j <- i + 1L x[[i]] <<- merger(x[[i]], x[[j]]) w[[i]] <<- c(w[[i]], w[[j]]) vals[i] <<- solver(x[[i]], w[[i]]) inds[[i]] <<- c(inds[[i]], inds[[j]]) keep <- seq_len(n)[-j] x <<- x[keep] w <<- w[keep] vals <<- vals[keep] inds <<- inds[keep] n <<- n - 1L } } else { function(i) { ## In the "simple" case, merge only indices and values. j <- i + 1L inds[[i]] <<- c(inds[[i]], inds[[j]]) vals[i] <<- solver(x[inds[[i]]], w[inds[[i]]]) keep <- seq_len(n)[-j] vals <<- vals[keep] inds <<- inds[keep] n <<- n - 1L } } i <- 1L repeat { if(i < n) { if((vals[i] > vals[i + 1])) { combine(i) while((i > 1L) && (vals[i - 1L] > vals[i])) { combine(i - 1L) i <- i - 1L } } else i <- i + 1L } else break } rep.int(vals, lengths(inds)) } clue/R/hierarchy.R0000644000175100001440000002341713036464014013532 0ustar hornikusers### * is.cl_hierarchy ## Determine whether an object is a hierarchy. ## Note that hierarchies are n-trees, which can naturally be represented ## by their classes (as done via cl_classes()) or internal ultrametric ## obtained by assigning height one to all splits (as done by ## .cl_ultrametric_from_classes()). ## We typically used the latter, but note that this is an *internal* ## reprsentation. ## User-level, cl_dendrogram objects are indexed hierarchies, and ## cl_hierarchy objects are n-trees. The latter can be "converted" into ## the former (using height one splits) via as.cl_dendrogram(). is.cl_hierarchy <- function(x) UseMethod("is.cl_hierarchy") ## Default method. is.cl_hierarchy.default <- .false ## Package stats: hclust(). is.cl_hierarchy.hclust <- function(x) !is.unsorted(x$height) ## Package cluster: agnes() and diana() give objects inheriting from ## class "twins". is.cl_hierarchy.twins <- .true ## Package cluster: mona(). is.cl_hierarchy.mona <- .true ## Package ape: class "phylo". is.cl_hierarchy.phylo <- function(x) ape::is.ultrametric(x) ## Package clue: (virtual) class "cl_hierarchy". ## Note that "raw" cl_ultrametric objects are *not* hierarchies, as ## these are meant for numeric computations. ## ## Is this really a good idea? ## We can as.hclust() a cl_dendrogram and then it is a cl_hierarchy ... ## is.cl_hierarchy.cl_hierarchy <- .true ### * as.cl_hierarchy ## Note that cl_hierarchy conceptually is a virtual class, so there are ## no prototypes and no cl_hierarchy() creator. .cl_hierarchy_classes <- "cl_hierarchy" as.cl_hierarchy <- function(x) { if(is.cl_hierarchy(x)) { if(!inherits(x, "cl_hierarchy")) .make_container(x, .cl_hierarchy_classes) else x } else .make_container(as.cl_ultrametric(x), .cl_hierarchy_classes) } ### * print.cl_hierarchy print.cl_hierarchy <- function(x, ...) .print_container(x, "cl_hierarchy", ...) ### * Complex.cl_hierarchy ## No Complex() for any kind of hierarchy. Complex.cl_hierarchy <- function(z) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ### * Math.cl_hierarchy ## No Math() for any kind of hierarchy. Math.cl_hierarchy <- function(x, ...) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ### * Ops.cl_hierarchy Ops.cl_hierarchy <- function(e1, e2) { if(nargs() == 1L) stop(gettextf("Unary '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ## Only comparisons are supprorted. if(!(as.character(.Generic) %in% c("<", "<=", ">", ">=", "==", "!="))) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) if(n_of_objects(e1) != n_of_objects(e2)) stop("Hierarchies must have the same number of objects.") c1 <- cl_classes(e1) c2 <- cl_classes(e2) switch(.Generic, "<=" = all(is.finite(match(c1, c2))), "<" = all(is.finite(match(c1, c2))) && any(is.na(match(c2, c1))), ">=" = all(is.finite(match(c2, c1))), ">" = all(is.finite(match(c2, c1))) && any(is.na(match(c1, c2))), "==" = all(is.finite(match(c1, c2))) && all(is.finite(match(c2, c1))), "!=" = any(is.na(match(c1, c2))) || any(is.na(match(c2, c1)))) } ### * Summary.cl_hierarchy ## ## This is really the same as Summary.cl_partition(). ## Summary.cl_hierarchy <- function(..., na.rm = FALSE) { ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) if(!ok) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) args <- list(...) switch(.Generic, "min" = cl_meet(cl_ensemble(list = args)), "max" = cl_join(cl_ensemble(list = args)), "range" = { cl_ensemble(min = cl_meet(cl_ensemble(list = args)), max = cl_join(cl_ensemble(list = args))) }) } ### * as.hclust.cl_hierarchy as.hclust.cl_hierarchy <- function(x, ...) as.hclust(.get_representation(x), ...) ### * is.cl_dendrogram ## ## Once we have cl_dendrogram testing, we can simplify cl_hierarchy ## testing. E.g., ## is.cl_hierachy.default <- is.cl_dendrogram ## should be ok, and we can add cl_hierarchy predicates for hierarchies ## which are not dendrograms on top of that. ## is.cl_dendrogram <- function(x) UseMethod("is.cl_dendrogram") ## Default method. is.cl_dendrogram.default <- .false ## Package stats: hclust(). is.cl_dendrogram.hclust <- function(x) !is.unsorted(x$height) ## Package cluster: agnes() and diana() give objects inheriting from ## class "twins". is.cl_dendrogram.twins <- .true ## Package cluster: mona(). is.cl_dendrogram.mona <- .true ## Package ape: class "phylo". is.cl_dendrogram.phylo <- function(x) ape::is.ultrametric(x) ## (We could also support ape's class "matching" via coercion to class ## "phylo".) ## Package clue: (virtual) class "cl_dendrogram". is.cl_dendrogram.cl_dendrogram <- .true ### * as.cl_dendrogram .cl_dendrogram_classes <- c("cl_dendrogram", "cl_hierarchy") as.cl_dendrogram <- function(x) { if(is.cl_dendrogram(x)) { if(!inherits(x, "cl_dendrogram")) .make_container(x, .cl_dendrogram_classes) else x } else .make_container(as.cl_ultrametric(x), .cl_dendrogram_classes) } ### * print.cl_dendrogram print.cl_dendrogram <- function(x, ...) .print_container(x, "cl_dendrogram", ...) ### * plot.cl_dendrogram plot.cl_dendrogram <- function(x, ...) plot(cl_ultrametric(.get_representation(x)), ...) ### * Group methods for cl_dendrogram objects. Ops.cl_dendrogram <- function(e1, e2) { if(nargs() == 1L) stop(gettextf("Unary '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) ## Only comparisons are supprorted. if(!(as.character(.Generic) %in% c("<", "<=", ">", ">=", "==", "!="))) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) u1 <- cl_ultrametric(e1) u2 <- cl_ultrametric(e2) if(length(u1) != length(u2)) stop("Dendrograms must have the same number of objects.") switch(.Generic, "<=" = all(u1 <= u2), "<" = all(u1 <= u2) && any(u1 < u2), ">=" = all(u1 >= u2), ">" = all(u1 >= u2) && any(u1 > u2), "==" = all(u1 == u2), "!=" = any(u1 != u2)) } ### * Summary.cl_dendrogram ## ## This is really the same as Summary.cl_hierarchy() ... ## We cannot really call the poset specific internal meet and join ## functions from here as e.g. max(D, H) (D a dendrogram, H an n-tree) ## should use the n-tree poset functions ... ## However, dispatch for cl_dendrogram should not be needed if we also ## dispatch on cl_hierarchy ... ## ## Summary.cl_dendrogram <- ## function(..., na.rm = FALSE) ## { ## ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) ## if(!ok) ## stop(gettextf("Generic '%s' not defined for \"%s\" objects.", ## .Generic, .Class)) ## args <- list(...) ## switch(.Generic, ## "min" = cl_meet(cl_ensemble(list = args)), ## "max" = cl_join(cl_ensemble(list = args)), ## "range" = { ## cl_ensemble(min = cl_meet(cl_ensemble(list = args)), ## max = cl_join(cl_ensemble(list = args))) ## }) ## } ### * as.hclust.cl_dendrogram ## ## This is really the same as as.hclust.cl_hierarchy() ... ## Dispatch for cl_dendrogram should not be needed if we also dispatch ## on cl_hierarchy ... ## ## as.hclust.cl_dendrogram <- ## function(x, ...) ## as.hclust(.get_representation(x), ...) ### ** cut.cl_dendrogram ## Not perfect as this perhaps return something more "classed" in the ## spirit of clue ... cut.cl_dendrogram <- function(x, ...) cutree(as.hclust(x), ...) ### * Utilities ## To turn a mona object into a cl_dendrogram, we need to be able to ## compute its associated ultrametric. Hence, provide a cophenetic() ## method for mona objects ... cophenetic.mona <- function(x) { no <- length(x$order) ns <- max(x$step) + 1 m <- matrix(NA, no, no) FOO <- function(ind, step, s) { if(length(ind) <= 1) return() grp <- c(0, cumsum(step == s)) ind <- split(ind, grp) len <- length(ind) for(a in seq_len(len)) { for(b in seq_len(a - 1L)) { ## Need both as we currently cannot assume that the ## indices are sorted. Alternatively, work with the ## sequence from one to the number of objects, and ## reorder at the end ... m[ind[[a]], ind[[b]]] <<- s m[ind[[b]], ind[[a]]] <<- s } } ind <- ind[lengths(ind) > 1L] pos <- which(step == s) step <- split(step[-pos], grp[-1][-pos]) if(is.null(step)) return() for(a in seq_along(ind)) FOO(ind[[a]], step[[a]], s + 1) } FOO(x$order, x$step, 1) m[is.na(m)] <- ns m <- ns - m rownames(m) <- rownames(x$data) as.dist(m) } ## And while we're at it ... ## (Of course, as.hclust() should really "know" that a cophenetic() ## method is available ...) as.hclust.mona <- function(x, ...) hclust(cophenetic(x), "single") ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/sumt.R0000644000175100001440000000722111304023136012527 0ustar hornikuserssumt <- function(x0, L, P, grad_L = NULL, grad_P = NULL, method = NULL, eps = NULL, q = NULL, verbose = NULL, control = list()) { ## Default values: make it nice for others to call us. if(is.null(eps)) eps <- sqrt(.Machine$double.eps) if(is.null(method)) method <- "CG" if(is.null(q)) q <- 10 if(is.null(verbose)) verbose <- getOption("verbose") Phi <- function(rho, x) L(x) + rho * P(x) if(is.null(grad_L) || is.null(grad_P)) { make_Phi <- function(rho) { function(x) Phi(rho, x) } make_grad_Phi <- function(rho) NULL } else { grad_Phi <- function(rho, x) grad_L(x) + rho * grad_P(x) make_Phi <- if(method == "nlm") { function(rho) { function(x) .structure(Phi(rho, x), gradient = grad_Phi(rho, x)) } } else function(rho) { function(x) Phi(rho, x) } make_grad_Phi <- function(rho) { function(x) grad_Phi(rho, x) } } ## ## For the penalized minimization, the Newton-type nlm() may be ## computationally infeasible (although it works much faster for ## fitting ultrametrics to the Phonemes data). ## De Soete recommends using Conjugate Gradients. ## We provide a simple choice: by default, optim(method = "CG") is ## used. If method is non-null and not "nlm", we use optim() with ## this method. In both cases, control gives the control parameters ## for optim(). ## If method is "nlm", nlm() is used, in which case control is ## ignored. Note that we call nlm() with checking analyticals ## turned off, as in some cases (e.g. when fitting ultrametrics) the ## penalty function is not even continuous ... optimize_with_penalty <- if(method == "nlm") function(rho, x) nlm(make_Phi(rho), x, check.analyticals = FALSE) $ estimate else { function(rho, x) optim(x, make_Phi(rho), gr = make_grad_Phi(rho), method = method, control = control) $ par } ## Note also that currently we do not check whether optimization was ## "successful" ... ## ## We currently require that x0 be a *list* of start values, the ## length of which gives the number of SUMT runs. But as always, ## let's be nice to users and developers, just in case ... if(!is.list(x0)) x0 <- list(x0) v_opt <- Inf x_opt <- NULL rho_opt <- NULL for(run in seq_along(x0)) { if(verbose) message(gettextf("SUMT run: %d", run)) x <- x0[[run]] ## ## Better upper/lower bounds for rho? rho <- max(L(x), 0.00001) / max(P(x), 0.00001) ## if(verbose) message(gettextf("Iteration: 0 Rho: %g P: %g", rho, P(x))) iter <- 1L repeat { ## ## Shouldnt't we also have maxiter, just in case ...? ## if(verbose) message(gettextf("Iteration: %d Rho: %g P: %g", iter, rho, P(x))) x_old <- x x <- optimize_with_penalty(rho, x) if(max(abs(x_old - x)) < eps) break iter <- iter + 1L rho <- q * rho } v <- Phi(rho, x) if(v < v_opt) { v_opt <- v x_opt <- x rho_opt <- rho } if(verbose) message(gettextf("Minimum: %g", v_opt)) } .structure(list(x = x_opt, L = L(x_opt), P = P(x_opt), rho = rho_opt, call = match.call()), class = "sumt") } clue/R/prototypes.R0000644000175100001440000000346711304023136013777 0ustar hornikuserscl_prototypes <- function(x) UseMethod("cl_prototypes") ## No default method. ## Package stats: kmeans() (R 2.1.0 or better). cl_prototypes.kmeans <- function(x) x$centers ## Package cluster: clara() always gives prototypes. cl_prototypes.clara <- function(x) x$medoids ## Package cluster: fanny() never gives prototypes. ## Package cluster: pam() does not give prototypes if given a ## dissimilarity matrix. cl_prototypes.pam <- function(x) { p <- x$medoids if(!is.matrix(p)) stop("Cannot determine prototypes.") p } ## Package cba: ccfkms(). cl_prototypes.ccfkms <- cl_prototypes.kmeans ## Package cclust: cclust(). cl_prototypes.cclust <- cl_prototypes.kmeans ## Package e1071: cmeans() gives objects of class "fclust". cl_prototypes.fclust <- cl_prototypes.kmeans ## Package e1071: cshell(). cl_prototypes.cshell <- cl_prototypes.kmeans ## Package e1071: bclust(). cl_prototypes.bclust <- cl_prototypes.kmeans ## Package flexclust: kcca() returns objects of S4 class "kcca" which ## extends S4 class "flexclust". cl_prototypes.kcca <- function(x) methods::slot(x, "centers") ## Package kernlab: specc() and kkmeans() return objects of S4 class ## "specc". cl_prototypes.specc <- function(x) kernlab::centers(x) ## Package mclust: Mclust(). cl_prototypes.Mclust <- function(x) { p <- x$mu ## For multidimensional models, we get a matrix whose columns are ## the means of each group in the best model, and hence needs to be ## transposed. if(is.matrix(p)) p <- t(p) p } ## Package clue: cl_pam(). cl_prototypes.cl_pam <- function(x) x$prototypes ## Package clue: (virtual) class "cl_partition". cl_prototypes.cl_partition <- function(x) cl_prototypes(.get_representation(x)) ## Package clue: pclust(). cl_prototypes.pclust <- function(x) x$prototypes clue/R/fuzziness.R0000644000175100001440000000435013435044610013606 0ustar hornikuserscl_fuzziness <- function(x, method = NULL, normalize = TRUE) { x <- as.cl_ensemble(x) out <- double(length(x)) ## ## The docs say that we should only have partitions ... attr(out, "description") <- "Fuzziness" class(out) <- "cl_fuzziness" parties <- vapply(x, is.cl_partition, NA) if(!(length(x) || any(parties))) { ## Currently, no fuzzy hierarchies ... return(out) } ## if(!is.function(method)) { builtin_methods <- c("PC", "PE") builtin_method_names <- c("partition coefficient", "partition entropy") if(is.null(method)) ind <- 1 else if(is.na(ind <- pmatch(tolower(method), tolower(builtin_methods)))) stop(gettextf("Value '%s' is not a valid abbreviation for a fuzziness method.", method), domain = NA) method <- paste0(".cl_fuzziness_partition_", builtin_methods[ind]) method_name <- builtin_method_names[ind] if(normalize) method_name <- paste("normalized", method_name) } else method_name <- "user-defined method" out[parties] <- as.numeric(sapply(x[parties], method, normalize)) attr(out, "description") <- paste("Fuzziness using", method_name) out } .cl_fuzziness_partition_PC <- function(x, normalize = TRUE) { ## Dunn's Partition Coefficient, see also ?fanny. ## Note that we normalize differently ... if(!.maybe_is_proper_soft_partition(x) && is.cl_hard_partition(x)) return(1 - normalize) pc <- sum(cl_membership(x) ^ 2) / n_of_objects(x) if(normalize) pc <- (1 - pc) / (1 - 1 / n_of_classes(x)) pc } .cl_fuzziness_partition_PE <- function(x, normalize = TRUE) { ## Bezdek's Partition Entropy. ## Note that we normalize differently ... if(!.maybe_is_proper_soft_partition(x) && is.cl_hard_partition(x)) return(0) M <- cl_membership(x) pe <- - sum(ifelse(M > 0, M * log(M), 0)) / n_of_objects(x) if(normalize) pe <- pe / log(n_of_classes(x)) pe } print.cl_fuzziness <- function(x, ...) { cat(attr(x, "description"), ":\n", sep = "") print(as.vector(x), ...) invisible(x) } clue/R/agreement.R0000644000175100001440000002713313435044376013532 0ustar hornikusers### * cl_agreement cl_agreement <- function(x, y = NULL, method = "euclidean", ...) { ## ## This code is repeated from cl_dissimilarity(), mutatis mutandis. ## Not really a big surprise ... ## x <- as.cl_ensemble(x) is_partition_ensemble <- (inherits(x, "cl_partition_ensemble") || all(vapply(x, .has_object_memberships, NA))) ## Be nice. if(is.character(y) || is.function(y)) { method <- y y <- NULL } if(is.function(method)) method_name <- "user-defined method" else { if(!inherits(method, "cl_agreement_method")) { ## Get the method definition and description from the ## registry. type <- ifelse(is_partition_ensemble, "partition", "hierarchy") method <- get_cl_agreement_method(method, type) } method_name <- method$description method <- method$definition } if(!is.null(y)) { y <- as.cl_ensemble(y) is_partition_ensemble_y <- (inherits(y, "cl_partition_ensemble") || all(vapply(x, .has_object_memberships, NA))) if(!identical(is_partition_ensemble, is_partition_ensemble_y)) stop("Cannot mix partitions and hierarchies.") if(n_of_objects(x) != n_of_objects(y)) stop("All clusterings must have the same number of objects.") ## Build a cross-proximity object of cross-agreements. d <- matrix(0, length(x), length(y)) for(j in seq_along(y)) d[, j] <- sapply(x, method, y[[j]], ...) dimnames(d) <- list(names(x), names(y)) return(cl_cross_proximity(d, method_name, class = "cl_cross_agreement")) } ## Otherwise, build a proximity object of dissimilarities. n <- length(x) d <- vector("list", length = n - 1L) ind <- seq_len(n) while(length(ind) > 1L) { j <- ind[1L] ind <- ind[-1L] d[[j]] <- sapply(x[ind], method, x[[j]], ...) } ## ## We assume that self-agreements are always one ... ## cl_proximity(unlist(d), method_name, labels = names(x), self = rep.int(1, length(x)), size = n, class = "cl_agreement") } ### ** .cl_agreement_partition_euclidean .cl_agreement_partition_euclidean <- function(x, y) { ## ## Upper bound for maximal dissimilarity, maybe improve eventually. d_max <- sqrt(2 * n_of_objects(x)) ## 1 - .cl_dissimilarity_partition_euclidean(x, y) / d_max } ### ** .cl_agreement_partition_manhattan .cl_agreement_partition_manhattan <- function(x, y) { ## ## Upper bound for maximal dissimilarity, maybe improve eventually. d_max <- 2 * n_of_objects(x) ## 1 - .cl_dissimilarity_partition_manhattan(x, y) / d_max } ### ** .cl_agreement_partition_Rand .cl_agreement_partition_Rand <- function(x, y) { n <- n_of_objects(x) ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) x <- table(cl_class_ids(x), cl_class_ids(y)) ## ## The number A of concordant pairs is given by ## A = choose(n,2) + \sum_{i,j} x_{ij}^2 ## - (1/2) * (\sum_i x_{i.}^2 + \sum_j x_{.j}^2) ## = choose(n,2) + 2 \sum_{i,j} choose(x_{ij},2) ## - (\sum_i choose(x_{i.},2) + \sum_j choose(x_{.j},2) ## with the first version certainly much faster to compute. ## 1 + (sum(x^2) - (sum(rowSums(x)^2) + sum(colSums(x)^2)) / 2) / choose(n, 2) } ### ** .cl_agreement_partition_cRand .cl_agreement_partition_cRand <- function(x, y) { if(!is.cl_hard_partition(x) || !is.cl_hard_partition(y)) stop("Can only handle hard partitions.") n <- n_of_objects(x) x <- table(cl_class_ids(x), cl_class_ids(y)) ## ## The basic formula is ## (Sxy - E) / ((Sx. + S.y) / 2 - E) ## where ## Sxy = \sum_{i,j} choose(x_{ij}, 2) ## Sx. = \sum_i choose(x_{i.}, 2) ## S.y = \sum_j choose(x_{.j}, 2) ## and ## E = Sx. * S.y / choose(n, 2) ## We replace the bincoefs by the corresponding sums of squares, ## getting ## (Txy - F) / ((Tx. + T.y) / 2 - F) ## where ## Txy = \sum_{i,j} x_{ij}^2 - n ## Tx. = \sum_i x_{i.}^2 - n ## T.y = \sum_j x_{.j}^2 - n ## and ## F = Tx. * T.y / (n^2 - n) ## Txy <- sum(x ^ 2) - n Tx. <- sum(rowSums(x) ^ 2) - n T.y <- sum(colSums(x) ^ 2) - n F <- Tx. * T.y / (n ^ 2 - n) (Txy - F) / ((Tx. + T.y) / 2 - F) } ### ** .cl_agreement_partition_NMI .cl_agreement_partition_NMI <- function(x, y) { if(!is.cl_hard_partition(x) || !is.cl_hard_partition(y)) stop("Can only handle hard partitions.") x <- table(cl_class_ids(x), cl_class_ids(y)) x <- x / sum(x) m_x <- rowSums(x) m_y <- colSums(x) y <- outer(m_x, m_y) i <- which((x > 0) & (y > 0)) out <- sum(x[i] * log(x[i] / y[i])) e_x <- sum(m_x * log(ifelse(m_x > 0, m_x, 1))) e_y <- sum(m_y * log(ifelse(m_y > 0, m_y, 1))) out / sqrt(e_x * e_y) } ### ** .cl_agreement_partition_KP .cl_agreement_partition_KP <- function(x, y) { ## Agreement measure due to Katz & Powell (1953, Psychometrika), see ## also Messatfa (1992, Journal of Classification). n <- n_of_objects(x) ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) x <- table(cl_class_ids(x), cl_class_ids(y)) A_xy <- sum(x ^ 2) A_x. <- sum(rowSums(x) ^ 2) A_.y <- sum(colSums(x) ^ 2) (n^2 * A_xy - A_x. * A_.y) / sqrt(A_x. * (n^2 - A_x.) * A_.y * (n^2 - A_.y)) } ### ** .cl_agreement_partition_angle .cl_agreement_partition_angle <- function(x, y) { ## Maximal angle between the matched memberships. k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) ## Match classes from conforming memberships. ind <- solve_LSAP(crossprod(M_x, M_y), maximum = TRUE) sum(M_x * M_y[, ind]) / sqrt(sum(M_x ^ 2) * sum(M_y ^ 2)) } ### ** .cl_agreement_partition_diag .cl_agreement_partition_diag <- function(x, y) { ## Maximal co-classification rate. k <- max(n_of_classes(x), n_of_classes(y)) M_x <- cl_membership(x, k) M_y <- cl_membership(y, k) ## Match classes from conforming memberships. ind <- solve_LSAP(crossprod(M_x, M_y), maximum = TRUE) sum(M_x * M_y[, ind]) / n_of_objects(x) } ### ** .cl_agreement_partition_FM .cl_agreement_partition_FM <- function(x, y) { ## Fowlkes-Mallows index. n <- n_of_objects(x) ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) x <- table(cl_class_ids(x), cl_class_ids(y)) (sum(x ^ 2) - n) / sqrt((sum(rowSums(x) ^ 2) - n) * (sum(colSums(x) ^ 2) - n)) } ### ** .cl_agreement_partition_Jaccard .cl_agreement_partition_Jaccard <- function(x, y) { ## Jaccard index. n <- n_of_objects(x) ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) x <- table(cl_class_ids(x), cl_class_ids(y)) Z <- sum(x ^ 2) (Z - n) / (sum(rowSums(x) ^ 2) + sum(colSums(x) ^ 2) - n - Z) } ### ** .cl_agreement_partition_purity .cl_agreement_partition_purity <- function(x, y) { ## Purity of classes of x with respect to those of y: relative ## fraction of "optimally matched and collapsed" joint class ## frequencies, i.e., \sum_i \max_j c_{ij} / n. n <- n_of_objects(x) ## Handle soft partitions using the corresponding hard ones. ## (At least, for the time being.) x <- table(cl_class_ids(x), cl_class_ids(y)) sum(apply(x, 1L, max)) / n } .cl_agreement_partition_PS <- function(x, y) { ## Prediction Strength as used in Tibshirani and Walter (2005), ## "Cluster Validation by Prediction Strength", JCGS. ## See Eqn 2.1 in the reference: this is ## min_l rate of different objects in the same class in partition ## A and in class l in partition B, ## where the min is taken over all classes l of partition B. x <- table(cl_class_ids(x), cl_class_ids(y)) s <- rowSums(x) min((rowSums(x ^ 2) - s) / (s * (s - 1)), na.rm = TRUE) } ## Some computations useful for interpreting some of the above. ## ## Consider two hard partitions A and B and write ## a_{ik} ... indicator of object i in class k for partition A ## b_{il} ... indicator of object i in class l for partition B ## (so that the a_{ik} and b_{il} are of course the membership matrices ## of the partitions). ## ## Then obviously ## \sum_i a_{ik} b_{il} = m_{kl} ## is the number of objects in class k for A and in class l for B, and ## \sum_i a_{ik} = m_{k.} = # objects in class k for A ## \sum_i b_{il} = m_{.l} = # objects in class l for B ## ## Number of pairs of objects in the same classes for both A and B: ## \sum_{i, j, k, l} a_{ik} a_{jk} b_{il} b_{jl} ## = \sum_{k, l} \sum_i a_{ik} b_{il} \sum_j a_{jk} b_{jl} ## = \sum_{k, l} m_{kl} ^ 2 ## This includes the n pairs with identical objects, hence: ## Number of distinct pairs of objects in the same classes for both A ## and B: ## (\sum_{k, l} m_{kl} ^ 2 - n) / 2 ## ## Number of pairs of objects in the same class for A: ## \sum_{i, j, k} a_{ik} a_{jk} ## = \sum_k \sum_i a_{ik} \sum_j a_{jk} ## = \sum_k m_{k.} ^ 2 ## Again, this includes the n pairs with identical objects, hence: ## Number of distinct pairs of objects in the same class for A: ## (\sum_k m_{k.} ^ 2 - n) / 2 ## ## Similarly, \sum_l m_{.l} ^ 2 corresponds to the number of pairs of ## objects in the same class for B. ## ## Finally, to get the number of pairs of objects in different classes ## for both A and B, we note that this is the total number of pairs, ## minus the sum of the numbers of those in the same class for A and for ## B, respectively, plus the number of pairs in the same class for both ## A and B. ## ## This makes e.g. the interpretation of some of the Fowlkes-Mallows or ## Rand agreement indices rather straightforward. ### ** .cl_agreement_hierarchy_euclidean .cl_agreement_hierarchy_euclidean <- function(x, y) 1 / (1 + .cl_dissimilarity_hierarchy_euclidean(x, y)) ### ** .cl_agreement_hierarchy_manhattan .cl_agreement_hierarchy_manhattan <- function(x, y) 1 / (1 + .cl_dissimilarity_hierarchy_manhattan(x, y)) ### ** .cl_agreement_hierarchy_cophenetic .cl_agreement_hierarchy_cophenetic <- function(x, y) { ## Cophenetic correlation. if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) cor(cl_object_dissimilarities(x), cl_object_dissimilarities(y)) } ### ** .cl_agreement_hierarchy_angle .cl_agreement_hierarchy_angle <- function(x, y) { ## Angle between ultrametrics. if(!.has_object_dissimilarities(x) || !.has_object_dissimilarities(y)) return(NA) u_x <- cl_object_dissimilarities(x) u_y <- cl_object_dissimilarities(y) sum(u_x * u_y) / sqrt(sum(u_x ^ 2) * sum(u_y ^ 2)) } ### ** .cl_agreement_hierarchy_gamma .cl_agreement_hierarchy_gamma <- function(x, y) 1 - .cl_dissimilarity_hierarchy_gamma(x, y) ### * [.cl_agreement "[.cl_agreement" <- function(x, i, j) { y <- NextMethod("[") if(!inherits(y, "cl_agreement")) { description <- attr(x, "description") return(cl_cross_proximity(y, description = description, class = "cl_cross_agreement")) } y } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/proximity.R0000644000175100001440000001244311304023136013605 0ustar hornikusers### * cl_proximity cl_proximity <- function(x, description, class = NULL, labels = NULL, self = NULL, size = NULL) { ## Similar to as.dist(), in a way. ## Currently, as.dist() is not generic, so we cannot provide a ## cl_proximity method for it. Hence, we have our dissimilarities ## and ultrametrics extend dist, and we use capitalized names for ## the attributes provided for compatibility with dist (Size and ## Labels). if(inherits(x, "dist")) { ## Explicitly deal with dist objects. ## Useful in particular because cophenetic() returns them. out <- x if(is.null(size)) size <- attr(x, "Size") if(is.null(labels)) labels <- attr(x, "Labels") } else if(inherits(x, "cl_proximity") || !(is.matrix(x) && (nrow(x) == ncol(x)))) out <- x else { ## Actually, x should really be a square symmetric matrix. ## The "self-proximities" in the main diagonal must be stored ## provided there is one non-zero entry. self <- diag(x) if(all(self == 0)) self <- NULL out <- x[row(x) > col(x)] if(is.null(labels)) { if(!is.null(rownames(x))) labels <- rownames(x) else if(!is.null(colnames(x))) labels <- colnames(x) } } if(is.null(size)) size <- as.integer((sqrt(1 + 8 * length(out)) + 1) / 2) attributes(out) <- list(Size = size, Labels = labels, description = description, self = self) class(out) <- unique(c(class, "cl_proximity")) out } ### * names.cl_proximity names.cl_proximity <- function(x) NULL ### * print.cl_proximity print.cl_proximity <- function(x, ...) { description <- attr(x, "description") if(length(description) > 0L) { ## Could make this generic ... kind <- if(inherits(x, "cl_dissimilarity")) "Dissimilarities" else if(inherits(x, "cl_agreement")) "Agreements" else "Proximities" cat(sprintf("%s using %s", kind, description), ":\n", sep = "") } m <- format(as.matrix(x)) if(is.null(self <- attr(x, "self"))) m[row(m) <= col(m)] <- "" else m[row(m) < col(m)] <- "" print(if(is.null(self)) m[-1, -attr(x, "Size")] else m, quote = FALSE, right = TRUE, ...) invisible(x) } ### * as.matrix.cl_proximity as.matrix.cl_proximity <- function(x, ...) { size <- attr(x, "Size") m <- matrix(0, size, size) m[row(m) > col(m)] <- x m <- m + t(m) if(!is.null(self <- attr(x, "self"))) { diag(m) <- self } ## ## stats:::as.matrix.dist() provides default dimnames ## (seq_len(size)) if no labels are available. ## We used to do this too, but ... if(!is.null(labels <- attr(x, "Labels"))) dimnames(m) <- list(labels, labels) ## m } ### * [.cl_proximity "[.cl_proximity" <- function(x, i, j) { ## Subscripting proximity objects. ## Basically matrix-like, but proximity objects are always ## "matrices", hence no 'drop' argument. ## For double-index subscripting, if i and j are identical, ## structure and class are preserved. Otherwise, a cross-proximity ## object is returned (and methods for classes inheriting from ## proximity need to readjust the class info as needed). ## For single-index subscripting, no attempty is currently made at ## preserving structure and class where possible. (We might also ## change this to select objects, i.e., the same rows and columns.) size <- attr(x, "Size") if(missing(j)) { if(missing(i)) return(x) else j <- seq_len(size) } if(missing(i)) i <- seq_len(size) description <- attr(x, "description") ## RG's graph:::[.dist avoids as.matrix() in noting that for dist ## objects, entry (i,j) is at n(i-1) - i(i-1)/2 + j - i (in the ## veclh dist representation). We could do something similar, but ## note that not all proximities have zero diagonals (i.e., NULL ## "self" attributes). y <- as.matrix(x)[i, j, drop = FALSE] if(identical(i, j)) { ## Testing using identical() is rather defensive ... return(cl_proximity(y, description = description, class = class(x))) } cl_cross_proximity(y, description = description) } ### * cl_cross_proximity cl_cross_proximity <- function(x, description = NULL, class = NULL) { attr(x, "description") <- description class(x) <- c(class, "cl_cross_proximity") x } ### * print.cl_cross_proximity print.cl_cross_proximity <- function(x, ...) { description <- attr(x, "description") if(length(description) > 0L) { ## Could make this generic ... kind <- if(inherits(x, "cl_cross_dissimilarity")) "Cross-dissimilarities" else if(inherits(x, "cl_cross_agreement")) "Cross-agreements" else "Cross-proximities" cat(sprintf("%s using %s", kind, description), ":\n", sep = "") } print(matrix(as.vector(x), nrow = nrow(x), dimnames = dimnames(x)), ...) invisible(x) } ### ** print_description_prefix ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/consensus.R0000644000175100001440000011507514144530711013575 0ustar hornikusers### * cl_consensus cl_consensus <- function(x, method = NULL, weights = 1, control = list()) { ## ## Interfaces are a matter of taste. ## E.g., one might want to have a 'type' argument indication whether ## hard or soft partitions are sought. One could then do ## cl_consensus(x, method = "euclidean", type = "hard") ## to look for an optimal median (or least squares) hard partition ## (for euclidean dissimilarity). ## For us, "method" really indicates a certain algorithm, with its ## bells and whistles accessed via the 'control' argument. ## clusterings <- as.cl_ensemble(x) if(!length(clusterings)) stop("Cannot compute consensus of empty ensemble.") weights <- rep_len(weights, length(clusterings)) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") if(!is.function(method)) { if(!inherits(method, "cl_consensus_method")) { ## Get the method definition from the registry. type <- .cl_ensemble_type(clusterings) if(is.null(method)) method <- .cl_consensus_method_default(type) method <- get_cl_consensus_method(method, type) } method <- method$definition } method(clusterings, weights, control) } ### * .cl_consensus_partition_DWH .cl_consensus_partition_DWH <- function(clusterings, weights, control) { ## ## Could make things more efficient by subscripting on positive ## weights. ## (Note that this means control$order has to be subscripted as ## well.) ## max_n_of_classes <- max(sapply(clusterings, n_of_classes)) ## Control parameters. k <- control$k if(is.null(k)) k <- max_n_of_classes order <- control$order if(is.null(order)) order <- sample(seq_along(clusterings)) clusterings <- clusterings[order] weights <- weights[order] k_max <- max(k, max_n_of_classes) s <- weights / cumsum(weights) s[is.na(s)] <- 0 # Division by zero ... M <- cl_membership(clusterings[[1L]], k_max) for(b in seq_along(clusterings)[-1L]) { mem <- cl_membership(clusterings[[b]], k_max) ## Match classes from conforming memberships. ind <- solve_LSAP(crossprod(M, mem), maximum = TRUE) M <- (1 - s[b]) * M + s[b] * mem[, ind] if(k < k_max) M <- .project_to_leading_columns(M, k) } M <- .cl_membership_from_memberships(M[, seq_len(k), drop = FALSE], k) as.cl_partition(M) } ### * .cl_consensus_partition_AOS .cl_consensus_partition_AOS <- function(clusterings, weights, control, type = c("SE", "HE", "SM", "HM")) { ## The start of a general purpose optimizer for determining ## consensus partitions by minimizing ## \sum_b w_b d(M, M_b) ^ e ## = \sum_b \min_{P_b} w_b f(M, M_b P_b) ^ e ## for the special case where the criterion function is based on ## M and M_b P_b (i.e., column permutations of M_b), as opposed to ## the general case where d(M, M_b) = \min_{P_b} f(M, P_b, M_b) ## handled by .cl_consensus_partition_AOG(). ## ## The AO ("alternative optimization") proceeds by alternatively ## matching the M_b to M by minimizing f(M, M_b P_b) over P_b, and ## fitting M by minimizing \sum_b w_b f(M, M_b P_b) ^ e for fixed ## matchings. ## ## Such a procedure requires three ingredients: a function for ## matching M_b to M (in fact simply replacing M_b by the matched ## M_b P_b); a function for fitting M to the \{M_b P_b\}, and a ## function for computing the value of the criterion function ## corresponding to this fit (so that one can stop if the relative ## improvement is small enough). ## ## For the time being, we only use this to determine soft and hard ## Euclidean least squares consensus partitions (soft and hard ## Euclidean means), so the interface does not yet reflect the ## generality of the approach (which would either pass the three ## functions, or even set up family objects encapsulating the three ## functions). ## ## This special case is provided for efficiency and convenience. ## Using the special form of the criterion function, we can simply ## always work memberships with the same maximal number of columns, ## and with the permuted \{ M_b P_b \}. ## For the time being ... type <- match.arg(type) w <- weights / sum(weights) n <- n_of_objects(clusterings) k_max <- max(sapply(clusterings, n_of_classes)) ## Control parameters. k <- control$k if(is.null(k)) k <- k_max maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 100 nruns <- control$nruns reltol <- control$reltol if(is.null(reltol)) reltol <- sqrt(.Machine$double.eps) start <- control$start verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } nruns <- length(start) } else { if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } start <- replicate(nruns, .random_stochastic_matrix(n, k), simplify = FALSE) } ## The maximal (possible) number of classes in M and the \{ M_b \}. k_all <- max(k, k_max) value <- switch(type, SE = , HE = function(M, memberships, w) { sum(w * sapply(memberships, function(u) sum((u - M) ^ 2))) }, SM = , HM = function(M, memberships, w) { sum(w * sapply(memberships, function(u) sum(abs(u - M)))) }) ## Return the M[, ind] column permutation of M optimally matching N. match_memberships <- switch(type, SE = , HE = function(M, N) { M[, solve_LSAP(crossprod(N, M), maximum = TRUE), drop = FALSE] }, SM = , HM = function(M, N) { M[, solve_LSAP(.cxdist(N, M, "manhattan")), drop = FALSE] }) ## Function for fitting M to (fixed) memberships \{ M_b P_b \}. ## As we use a common number of columns for all membership matrices ## involved, we need to pass the desired 'k' ... fit_M <- switch(type, SE = function(memberships, w, k) { ## Update M as \sum w_b M_b P_b. M <- .weighted_sum_of_matrices(memberships, w, nrow(M)) ## If k < k_all, "project" as indicated in Gordon & ## Vichi (2001), p. 238. if(k < ncol(M)) M <- .project_to_leading_columns(M, k) M }, HE = , HM = function(memberships, w, k) { ## Compute M as \sum w_b M_b P_b. M <- .weighted_sum_of_matrices(memberships, w, nrow(M)) ## And compute a closest hard partition H(M) from ## that, using the first k columns of M. ids <- max.col(M[ , seq_len(k), drop = FALSE]) .cl_membership_from_class_ids(ids, ncol(M)) }, SM = .l1_fit_M) memberships <- lapply(clusterings, cl_membership, k_all) V_opt <- Inf M_opt <- NULL for(run in seq_along(start)) { if(verbose && (nruns > 1L)) message(gettextf("AOS run: %d", run)) M <- start[[run]] if(k < k_all) M <- cbind(M, matrix(0, nrow(M), k_all - k)) memberships <- lapply(memberships, match_memberships, M) old_value <- value(M, memberships, w) if(verbose) message(gettextf("Iteration: 0 *** value: %g", old_value)) iter <- 1L while(iter <= maxiter) { ## Fit M to the M_b P_b. M <- fit_M(memberships, w, k) ## Match the \{ M_b P_b \} to M. memberships <- lapply(memberships, match_memberships, M) ## Update value. new_value <- value(M, memberships, w) if(verbose) message(gettextf("Iteration: %d *** value: %g", iter, new_value)) if(abs(old_value - new_value) < reltol * (abs(old_value) + reltol)) break old_value <- new_value iter <- iter + 1L } if(new_value < V_opt) { converged <- (iter <= maxiter) V_opt <- new_value M_opt <- M } if(verbose) message(gettextf("Minimum: %g", V_opt)) } M <- .stochastify(M_opt) rownames(M) <- rownames(memberships[[1L]]) meta <- list(objval = value(M, memberships, w), converged = converged) M <- .cl_membership_from_memberships(M[, seq_len(k), drop = FALSE], k, meta) as.cl_partition(M) } .random_stochastic_matrix <- function(n, k) { M <- matrix(runif(n * k), n, k) M / rowSums(M) } .l1_fit_M <- function(memberships, w, k) { ## Determine stochastic matrix M with at most k leading nonzero ## columns such that ## ## \sum_b w_b \sum_{i,j} | m_{ij}(b) - m_{ij} | => min ## ## where the sum over j goes from 1 to k. ## ## Clearly, this can be done separately for each row, where we need ## to minimize ## ## \sum_b w_b \sum_j | y_j(b) - x_j | => min ## ## over all probability vectors x. Such problems can e.g. be solved ## via the following linear program: ## ## \sum_b \sum_j w_b e'(u(b) + v(b)) => min ## ## subject to ## ## u(1), v(1), ..., u(B), v(B), x >= 0 ## x + u(b) - v(b) = y(b), b = 1, ..., B ## e'x = 1 ## ## (where e = [1, ..., 1]). ## ## So we have one long vector z of "variables": ## ## z = [u(1)', v(1)', ..., u(B)', v(B)', x']' ## ## of length (2B + 1) k, with x the object of interest. ## Rather than providing a separate function for weighted L1 fitting ## of probability vectors we prefer doing "everything" at once, in ## order to avoid recomputing the coefficients and constraints of ## the associated linear program. B <- length(memberships) L <- (2 * B + 1) * k ## Set up associated linear program. ## Coefficients in the objective function. objective_in <- c(rep(w, each = 2 * k), rep.int(0, k)) ## Constraints. constr_mat <- rbind(diag(1, L), cbind(kronecker(diag(1, B), cbind(diag(1, k), diag(-1, k))), kronecker(rep.int(1, B), diag(1, k))), c(rep.int(0, 2 * B * k), rep.int(1, k))) constr_dir <- c(rep.int(">=", L), rep.int("==", B * k + 1L)) ind <- seq.int(from = 2 * B * k + 1L, length.out = k) nr <- NROW(memberships[[1L]]) nc <- NCOL(memberships[[1L]]) M <- matrix(0, nrow = nr, ncol = k) ## Put the memberships into one big array so that we can get their ## rows more conveniently (and efficiently): memberships <- array(unlist(memberships), c(nr, nc, B)) for(i in seq_len(nr)) { out <- lpSolve::lp("min", objective_in, constr_mat, constr_dir, c(rep.int(0, L), memberships[i, seq_len(k), ], 1)) M[i, ] <- out$solution[ind] } ## Add zero columns if necessary. if(k < nc) M <- cbind(M, matrix(0, nr, nc - k)) M } ### ** .cl_consensus_partition_soft_euclidean .cl_consensus_partition_soft_euclidean <- function(clusterings, weights, control) .cl_consensus_partition_AOS(clusterings, weights, control, "SE") ### ** .cl_consensus_partition_hard_euclidean .cl_consensus_partition_hard_euclidean <- function(clusterings, weights, control) .cl_consensus_partition_AOS(clusterings, weights, control, "HE") ### ** .cl_consensus_partition_soft_manhattan .cl_consensus_partition_soft_manhattan <- function(clusterings, weights, control) .cl_consensus_partition_AOS(clusterings, weights, control, "SM") ### ** .cl_consensus_partition_hard_manhattan .cl_consensus_partition_hard_manhattan <- function(clusterings, weights, control) .cl_consensus_partition_AOS(clusterings, weights, control, "HM") ### * .cl_consensus_partition_AOG .cl_consensus_partition_AOG <- function(clusterings, weights, control, type = c("GV1")) { ## The start of a general purpose optimizer for determining ## consensus partitions by minimizing ## \sum_b w_b d(M, M_b) ^ p ## = \sum_b \min_{P_b} w_b f(M, M_b, P_b) ^ e ## for general dissimilarity matrices which involve class matching ## via permutation matrices P_b. ## ## The AO ("Alternative Optimization") proceeds by alternating ## between determining the optimal permutations P_b by minimizing ## f(M, M_b, P_b) ## for fixed M, and fitting M by minimizing ## \sum_b w_b f(M, M_b, P_b) ^ e ## for fixed \{ P_b \}. ## ## We encapsulate this into functions fit_P() and fit_M() (and a ## value() function for the criterion function to be minimized with ## respect to both M and \{ P_b \}, even though the current ## interface does not yet reflect the generality of the approach. ## ## Note that rather than passing on information about the numbers of ## classes (e.g., needed for GV1) and representing all involved ## membership matrices with the same maximal number of columns, we ## use "minimal" representations with no dummy classes (strictly ## speaking, with the possible exception of M, for which the given k ## is used). ## For the time being ... type <- match.arg(type) w <- weights / sum(weights) n <- n_of_objects(clusterings) k_max <- max(sapply(clusterings, n_of_classes)) ## Control parameters. k <- control$k if(is.null(k)) k <- k_max maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 100L nruns <- control$nruns reltol <- control$reltol if(is.null(reltol)) reltol <- sqrt(.Machine$double.eps) start <- control$start verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } nruns <- length(start) } else { if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } start <- replicate(nruns, .random_stochastic_matrix(n, k), simplify = FALSE) } ## ## For the given memberships, we can simply use ncol() in the ## computations (rather than n_of_classes(), because we used ## cl_membership() to create them. For M, the number of classes ## could be smaller than the given k "target". ## value <- function(M, permutations, memberships, w) { k <- .n_of_nonzero_columns(M) d <- function(u, p) { ## Compute the squared GV1 dissimilarity between M and u ## based on the M->u class matching p. nc_u <- ncol(u) if(nc_u == k) { ## Simple case: all classes are matched. sum((u[, p] - M) ^ 2) } else { ## Only include the matched non-dummy classes of M .. ind <- seq_len(k) ## ... which are matched to non-dummy classes of u. ind <- ind[p[ind] <= nc_u] sum((u[, p[ind]] - M[, ind]) ^ 2) } } sum(w * mapply(d, memberships, permutations)) } fit_P <- function(u, M) { ## Return a permutation representing a GV1 optimal matching of ## the columns of M to the columns of u (note the order of the ## arguments), using a minimal number of dummy classes (i.e., p ## has max(.n_of_nonzero_columns(M), n_of_classes(u)) entries). ## See also .cl_dissimilarity_partition_GV1(). C <- outer(colSums(M ^ 2), colSums(u ^ 2), `+`) - 2 * crossprod(M, u) nc_M <- .n_of_nonzero_columns(M) nc_u <- ncol(u) ## (See above for ncol() vs n_of_classes().) if(nc_M < nc_u) C <- rbind(C, matrix(0, nrow = nc_u - nc_M, ncol = nc_u)) else if(nc_M > nc_u) C <- cbind(C, matrix(0, nrow = nc_M, ncol = nc_M - nc_u)) solve_LSAP(C) } fit_M <- function(permutations, memberships, w) { ## Here comes the trickiest part ... ## ## In general, M = [m_{iq}] is determined as follows. ## Write value(M, permutations, memberships, w) as ## \sum_b \sum_i \sum_{p=1}^{k_b} \sum_{q=1}^k ## w_b (u_{ip}(b) - m_{iq})^2 x_{pq}(b) ## where U(b) and X(b) are the b-th membership matrix and the ## permutation matrix representing the M->U(b) non-dummy class ## matching (as always, note the order of the arguments). ## ## Let ## \beta_{iq} = \sum_b \sum_{p=1}^{k_b} w_b u_{ip}(b) x_{pq}(b) ## \alpha_q = \sum_b \sum_{p=1}^{k_b} w_b x_{pq}(b) ## and ## \bar{m}_{iq} = ## \cases{\beta_{iq}/\alpha_q, & $\alpha_q > 0$ \cr ## 0 & otherwise}. ## Then, as the cross-product terms cancel out, the value ## function rewrites as ## \sum_b \sum_i \sum_{p=1}^{k_b} \sum_{q=1}^k ## w_b (u_{ip}(b) - \bar{m}_{iq})^2 x_{pq}(b) ## + \sum_i \sum_q \alpha_q (\bar{m}_{iq} - m_{iq}) ^ 2, ## where the first term is a constant, and the minimum is found ## by solving ## \sum_q \alpha_q (\bar{m}_{iq} - m_{iq}) ^ 2 => min! ## s.t. ## m_{i1}, ..., m_{ik} >= 0, \sum_{iq} m_{iq} = 1. ## ## We can distinguish three cases. ## A. If S_i = \sum_q \bar{m}_{iq} = 1, things are trivial. ## B. If S_i = \sum_q \bar{m}_{iq} < 1. ## B1. If some \alpha_q are zero, then we can choose ## m_{iq} = \bar{m}_{iq} for those q with \alpha_q = 0; ## m_{iq} = 1 / number of zero \alpha's, otherwise. ## B2. If all \alpha_q are positive, we can simply ## equidistribute 1 - S_i over all classes as written ## in G&V. ## C. If S_i > 1, things are not so clear (as equidistributing ## will typically result in violations of the non-negativity ## constraint). We currently revert to using solve.QP() from ## package quadprog, as constrOptim() already failed in very ## simple test cases. ## ## Now consider \sum_{p=1}^{k_b} x_{pq}(b). If k <= k_b for all ## b, all M classes from 1 to k are matched to one of the k_b ## classes in U(b), hence the sum and also \alpha_q are one. ## But then ## \sum_q \bar{m}_{iq} ## = \sum_b \sum_{p=1}^{k_b} w_b u_{ip}(b) x_{pq}(b) ## <= \sum_b \sum_{p=1}^{k_b} w_b u_{ip}(b) ## = 1 ## with equality if k = k_b for all b. I.e., ## * If k = \min_b k_b = \max k_b, we are in case A. ## * If k <= \min_b k_b, we are in case B2. ## And it makes sense to handle these cases explicitly for ## efficiency reasons. ## And now for something completely different ... the code. k <- .n_of_nonzero_columns(M) nr_M <- nrow(M) nc_M <- ncol(M) nc_memberships <- sapply(memberships, ncol) if(k <= min(nc_memberships)) { ## Compute the weighted means \bar{M}. M <- .weighted_sum_of_matrices(mapply(function(u, p) u[ , p[seq_len(k)]], memberships, permutations, SIMPLIFY = FALSE), w, nr_M) ## And add dummy classes if necessary. if(k < nc_M) M <- cbind(M, matrix(0, nr_M, nc_M - k)) ## If we always got the same number of classes, we are ## done. Otherwise, equidistribute ... if(k < max(nc_memberships)) M <- pmax(M + (1 - rowSums(M)) / nc_M, 0) return(M) } ## Here comes the general case. ## First, compute the \alpha and \beta. alpha <- rowSums(rep(w, each = k) * mapply(function(p, n) p[seq_len(k)] <= n, permutations, nc_memberships)) ## Alternatively (more literally): ## X <- lapply(permutations, .make_X_from_p) ## alpha1 <- double(length = k) ## for(b in seq_along(permutations)) { ## alpha1 <- alpha1 + ## w[b] * colSums(X[[b]][seq_len(nc_memberships[b]), ]) ## } ## A helper function giving suitably permuted memberships. pmem <- function(u, p) { ## Only matched classes, similar to the one used in value(), ## maybe merge eventually ... v <- matrix(0, nr_M, k) ind <- seq_len(k) ind <- ind[p[ind] <= ncol(u)] if(any(ind)) v[ , ind] <- u[ , p[ind]] v } beta <- .weighted_sum_of_matrices(mapply(pmem, memberships, permutations, SIMPLIFY = FALSE), w, nr_M) ## Alternatively (more literally): ## beta1 <- matrix(0, nr_M, nc_M) ## for(b in seq_along(permutations)) { ## ind <- seq_len(nc_memberships[b]) ## beta1 <- beta1 + ## w[b] * memberships[[b]][, ind] %*% X[[b]][ind, ] ## } ## Compute the weighted means \bar{M}. M <- .cscale(beta, ifelse(alpha > 0, 1 / alpha, 0)) ## Alternatively (see comments for .cscale()): ## M1 <- beta %*% diag(ifelse(alpha > 0, 1 / alpha, 0)) ## And add dummy classes if necessary. if(k < nc_M) M <- cbind(M, matrix(0, nr_M, nc_M - k)) S <- rowSums(M) ## Take care of those rows with row sums < 1. ind <- (S < 1) if(any(ind)) { i_0 <- alpha == 0 if(any(i_0)) M[ind, i_0] <- 1 / sum(i_0) else M[ind, ] <- pmax(M[ind, ] + (1 - S[ind]) / nc_M, 0) } ## Take care of those rows with row sums > 1. ind <- (S > 1) if(any(ind)) { ## Argh. Call solve.QP() for each such i. Alternatively, ## could set up on very large QP, but is this any better? Dmat <- diag(alpha, nc_M) Amat <- t(rbind(rep.int(-1, nc_M), diag(1, nc_M))) bvec <- c(-1, rep.int(0, nc_M)) for(i in which(ind)) M[i, ] <- quadprog::solve.QP(Dmat, alpha * M[i, ], Amat, bvec)$solution } M } memberships <- lapply(clusterings, cl_membership) V_opt <- Inf M_opt <- NULL for(run in seq_along(start)) { if(verbose && (nruns > 1L)) message(gettextf("AOG run: %d", run)) M <- start[[run]] permutations <- lapply(memberships, fit_P, M) old_value <- value(M, permutations, memberships, w) message(gettextf("Iteration: 0 *** value: %g", old_value)) iter <- 1L while(iter <= maxiter) { ## Fit M. M <- fit_M(permutations, memberships, w) ## Fit \{ P_b \}. permutations <- lapply(memberships, fit_P, M) ## Update value. new_value <- value(M, permutations, memberships, w) if(verbose) message(gettextf("Iteration: %d *** value: %g", iter, new_value)) if(abs(old_value - new_value) < reltol * (abs(old_value) + reltol)) break old_value <- new_value iter <- iter + 1L } if(new_value < V_opt) { converged <- (iter <= maxiter) V_opt <- new_value M_opt <- M } if(verbose) message(gettextf("Minimum: %g", V_opt)) } M <- .stochastify(M_opt) ## Seems that M is always kept a k columns ... if not, use ## M <- .stochastify(M_opt[, seq_len(k), drop = FALSE]) rownames(M) <- rownames(memberships[[1L]]) ## Recompute the value, just making sure ... permutations <- lapply(memberships, fit_P, M) meta <- list(objval = value(M, permutations, memberships, w), converged = converged) M <- .cl_membership_from_memberships(M, k, meta) as.cl_partition(M) } ### ** .cl_consensus_partition_GV1 .cl_consensus_partition_GV1 <- function(clusterings, weights, control) .cl_consensus_partition_AOG(clusterings, weights, control, "GV1") ### * .cl_consensus_partition_GV3 .cl_consensus_partition_GV3 <- function(clusterings, weights, control) { ## Use a SUMT to solve ## \| Y - M M' \|_F^2 => min ## where M is a membership matrix and Y = \sum_b w_b M_b M_b'. n <- n_of_objects(clusterings) max_n_of_classes <- max(sapply(clusterings, n_of_classes)) ## Control parameters: ## k, k <- control$k if(is.null(k)) k <- max_n_of_classes ## nruns, nruns <- control$nruns ## start. start <- control$start w <- weights / sum(weights) comemberships <- lapply(clusterings, function(x) { ## No need to force a common k here. tcrossprod(cl_membership(x)) }) Y <- .weighted_sum_of_matrices(comemberships, w, n) ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else { if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } e <- eigen(Y, symmetric = TRUE) ## Use M <- U_k \lambda_k^{1/2}, or random perturbations ## thereof. M <- e$vectors[, seq_len(k), drop = FALSE] * rep(sqrt(e$values[seq_len(k)]), each = n) m <- c(M) start <- c(list(m), replicate(nruns - 1L, m + rnorm(length(m), sd = sd(m) / sqrt(3)), simplify = FALSE)) } y <- c(Y) L <- function(m) sum((y - tcrossprod(matrix(m, n))) ^ 2) P <- .make_penalty_function_membership(n, k) grad_L <- function(m) { M <- matrix(m, n) 4 * c((tcrossprod(M) - Y) %*% M) } grad_P <- .make_penalty_gradient_membership(n, k) out <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control)) M <- .stochastify(matrix(out$x, n)) rownames(M) <- rownames(cl_membership(clusterings[[1L]])) meta <- list(objval = L(c(M))) M <- .cl_membership_from_memberships(M, k, meta) as.cl_partition(M) } ### * .cl_consensus_partition_soft_symdiff .cl_consensus_partition_soft_symdiff <- function(clusterings, weights, control) { ## Use a SUMT to solve ## \sum_b w_b \sum_{ij} | c_{ij}(b) - c_{ij} | => min ## where C(b) = comembership(M(b)) and C = comembership(M) and M is ## a membership matrix. ## Control parameters: ## gradient, gradient <- control$gradient if(is.null(gradient)) gradient <- TRUE ## k, k <- control$k ## nruns, nruns <- control$nruns ## start. start <- control$start ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } max_n_of_classes <- max(sapply(clusterings, n_of_classes)) if(is.null(k)) k <- max_n_of_classes B <- length(clusterings) n <- n_of_objects(clusterings) w <- weights / sum(weights) comemberships <- lapply(clusterings, function(x) { ## No need to force a common k here. tcrossprod(cl_membership(x)) }) ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else { if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } ## Try using a rank k "root" of the weighted median of the ## comemberships as starting value. Y <- apply(array(unlist(comemberships), c(n, n, B)), c(1, 2), weighted_median, w) e <- eigen(Y, symmetric = TRUE) ## Use M <- U_k \lambda_k^{1/2}, or random perturbations ## thereof. M <- e$vectors[, seq_len(k), drop = FALSE] * rep(sqrt(e$values[seq_len(k)]), each = n) m <- c(M) start <- c(list(m), replicate(nruns - 1L, m + rnorm(length(m), sd = sd(m) / sqrt(3)), simplify = FALSE)) } L <- function(m) { M <- matrix(m, n) C_M <- tcrossprod(M) ## Note that here (as opposed to hard/symdiff) we take soft ## partitions as is without replacing them by their closest hard ## partitions. sum(w * sapply(comemberships, function(C) sum(abs(C_M - C)))) } P <- .make_penalty_function_membership(n, k) if(gradient) { grad_L <- function(m) { M <- matrix(m, n) C_M <- tcrossprod(M) .weighted_sum_of_matrices(lapply(comemberships, function(C) 2 * sign(C_M - C) %*% M), w, n) } grad_P <- .make_penalty_gradient_membership(n, k) } else grad_L <- grad_P <- NULL out <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control)) M <- .stochastify(matrix(out$x, n)) rownames(M) <- rownames(cl_membership(clusterings[[1L]])) meta <- list(objval = L(c(M))) M <- .cl_membership_from_memberships(M, k, meta) as.cl_partition(M) } ### * .cl_consensus_partition_hard_symdiff .cl_consensus_partition_hard_symdiff <- function(clusterings, weights, control) { ## ## This is mostly duplicated from relations. ## Once this is on CRAN, we could consider having clue suggest ## relations ... ## comemberships <- lapply(clusterings, function(x) { ## Here, we always turn possibly soft partitions to ## their closest hard partitions. ids <- cl_class_ids(x) outer(ids, ids, `==`) ## (Simpler than using tcrossprod() on ## cl_membership().) }) ## Could also create a relation ensemble from the comemberships and ## call relation_consensus(). B <- relations:::.make_fit_relation_symdiff_B(comemberships, weights) k <- control$k control <- control$control ## Note that currently we provide no support for finding *all* ## consensus partitions (but allow for specifying the solver). control$all <- FALSE I <- if(!is.null(k)) { ## ## We could actually get the memberships directly in this case. relations:::fit_relation_LP_E_k(B, k, control) ## } else relations:::fit_relation_LP(B, "E", control) ids <- relations:::get_class_ids_from_incidence(I) names(ids) <- cl_object_names(clusterings) as.cl_hard_partition(ids) } ### * .cl_consensus_hierarchy_cophenetic .cl_consensus_hierarchy_cophenetic <- function(clusterings, weights, control) { ## d <- .weighted_mean_of_object_dissimilarities(clusterings, weights) ## Alternatively: ## as.cl_dendrogram(ls_fit_ultrametric(d, control = control)) control <- c(list(weights = weights), control) as.cl_dendrogram(ls_fit_ultrametric(clusterings, control = control)) } ### * .cl_consensus_hierarchy_manhattan .cl_consensus_hierarchy_manhattan <- function(clusterings, weights, control) { ## Control parameters: ## gradient, gradient <- control$gradient if(is.null(gradient)) gradient <- TRUE ## nruns, nruns <- control$nruns ## start. start <- control$start ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } w <- weights / sum(weights) B <- length(clusterings) ultrametrics <- lapply(clusterings, cl_ultrametric) if(B == 1L) return(as.cl_dendrogram(ultrametrics[[1L]])) n <- n_of_objects(ultrametrics[[1L]]) labels <- cl_object_names(ultrametrics[[1L]]) ## We need to do ## ## \sum_b w_b \sum_{i,j} | u_{ij}(b) - u_{ij} | => min ## ## over all ultrametrics u. Let's use a SUMT (for which "gradients" ## can optionally be switched off) ... L <- function(d) { sum(w * sapply(ultrametrics, function(u) sum(abs(u - d)))) ## Could also do something like ## sum(w * sapply(ultrametrics, cl_dissimilarity, d, ## "manhattan")) } P <- .make_penalty_function_ultrametric(n) if(gradient) { grad_L <- function(d) { ## "Gradient" is \sum_b w_b sign(d - u(b)). .weighted_sum_of_vectors(lapply(ultrametrics, function(u) sign(d - u)), w) } grad_P <- .make_penalty_gradient_ultrametric(n) } else grad_L <- grad_P <- NULL if(is.null(start)) { ## Initialize by "random shaking" of the weighted median of the ## ultrametrics. Any better ideas? ## ## Using var(x) / 3 is really L2 ... ## x <- apply(matrix(unlist(ultrametrics), ncol = B), 1, weighted_median, w) start <- replicate(nruns, x + rnorm(length(x), sd = sd(x) / sqrt(3)), simplify = FALSE) } out <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control)) d <- .ultrametrify(out$x) meta <- list(objval = L(d)) d <- .cl_ultrametric_from_veclh(d, n, labels, meta) as.cl_dendrogram(d) } ### * .cl_consensus_hierarchy_majority .cl_consensus_hierarchy_majority <- function(clusterings, weights, control) { w <- weights / sum(weights) p <- control$p if(is.null(p)) p <- 1 / 2 else if(!is.numeric(p) || (length(p) != 1) || (p < 1 / 2) || (p > 1)) stop("Parameter 'p' must be in [1/2, 1].") classes <- lapply(clusterings, cl_classes) all_classes <- unique(unlist(classes, recursive = FALSE)) gamma <- double(length = length(all_classes)) for(i in seq_along(classes)) gamma <- gamma + w[i] * !is.na(match(all_classes, classes[[i]])) ## Rescale to [0, 1]. gamma <- gamma / max(gamma) maj_classes <- if(p == 1) { ## Strict consensus tree. all_classes[gamma == 1] } else all_classes[gamma > p] attr(maj_classes, "labels") <- attr(classes[[1L]], "labels") ## ## Stop auto-coercing that to dendrograms once we have suitable ways ## of representing n-trees. as.cl_hierarchy(.cl_ultrametric_from_classes(maj_classes)) ## } ### * Utilities ### ** .cl_consensus_method_default .cl_consensus_method_default <- function(type) { switch(type, partition = "SE", hierarchy = "euclidean", NULL) } ### ** .project_to_leading_columns .project_to_leading_columns <- function(x, k) { ## For a given matrix stochastic matrix x, return the stochastic ## matrix y which has columns from k+1 on all zero which is closest ## to x in the Frobenius distance. y <- x[, seq_len(k), drop = FALSE] y <- cbind(pmax(y + (1 - rowSums(y)) / k, 0), matrix(0, nrow(y), ncol(x) - k)) ## (Use the pmax to ensure that entries remain nonnegative.) } ### ** .make_X_from_p .make_X_from_p <- function(p) { ## X matrix corresponding to permutation p as needed for the AO ## algorithms. I.e., x_{ij} = 1 iff j->p(j)=i. X <- matrix(0, length(p), length(p)) i <- seq_along(p) X[cbind(p[i], i)] <- 1 X } ### ** .n_of_nonzero_columns ## ## Could turn this into n_of_classes.matrix(). .n_of_nonzero_columns <- function(x) sum(colSums(x) > 0) ## ### ** .cscale ## ## Move to utilities eventually ... .cscale <- function(A, x) { ## Scale the columns of matrix A by the elements of vector x. ## Formally, A %*% diag(x), but faster. ## Could also use sweep(A, 2, x, "*") rep(x, each = nrow(A)) * A } ## ## .make_penalty_function_membership .make_penalty_function_membership <- function(nr, nc) function(m) { sum(pmin(m, 0) ^ 2) + sum((rowSums(matrix(m, nr)) - 1) ^ 2) } ## .make_penalty_gradient_membership .make_penalty_gradient_membership <- function(nr, nc) function(m) { 2 * (pmin(m, 0) + rep.int(rowSums(matrix(m, nr)) - 1, nc)) } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/registration.R0000644000175100001440000003271611754400707014274 0ustar hornikusers### ### At least currently, all registries are meant and used for all types ### of clusterings (for the time being, partitions and hierarchies) ### simultaneously. ### ### * Internal stuff. .make_db_key <- function(name, type) paste(type, name, sep = "_") ### * General-purpose stuff. ### ### This currently insists on a given type: maybe it should simply list ### everything split according to type. But hey, it's internal stuff ### anyway (at least for the time being ...) ### get_methods_from_db <- function(db, type) { type <- match.arg(type, c("partition", "hierarchy")) pattern <- sprintf("^%s_", type) sub(pattern, "", grep(pattern, objects(db), value = TRUE)) } get_method_from_db <- function(db, type, name, msg) { ## ## Keep 'msg' here so that gettext()ing could work ... ## type <- match.arg(type, c("partition", "hierarchy")) db_keys <- objects(db) ind <- pmatch(.make_db_key(tolower(name), type), tolower(db_keys)) if(is.na(ind)) stop(msg, call. = FALSE, domain = NA) db[[db_keys[ind]]] } put_method_into_db <- function(db, type, name, value) { type <- match.arg(type, c("partition", "hierarchy")) db[[.make_db_key(name, type)]] <- value } ### * Consensus Method Registration. cl_consensus_methods_db <- new.env() get_cl_consensus_methods <- function(type) get_methods_from_db(cl_consensus_methods_db, type) get_cl_consensus_method <- function(name, type) { get_method_from_db(cl_consensus_methods_db, type, name, gettextf("Invalid consensus method '%s'.", name)) } set_cl_consensus_method <- function(name, type, definition, ...) { ## Register a @code{type} consensus method called @code{name} with ## definition @code{definition}. Provide more information where ## appropriate, e.g., @code{dissimilarity} d and @code{exponent} e ## for methods minimizing \sum_b d(x_b, x) ^ e. put_method_into_db(cl_consensus_methods_db, type, name, .structure(c(list(definition = definition), list(...)), class = "cl_consensus_method")) } set_cl_consensus_method("DWH", "partition", .cl_consensus_partition_DWH, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("soft/euclidean", "partition", .cl_consensus_partition_soft_euclidean, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("SE", "partition", .cl_consensus_partition_soft_euclidean, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("hard/euclidean", "partition", .cl_consensus_partition_hard_euclidean, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("HE", "partition", .cl_consensus_partition_hard_euclidean, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("soft/manhattan", "partition", .cl_consensus_partition_soft_manhattan, dissimilarity = "manhattan", exponent = 1) set_cl_consensus_method("SM", "partition", .cl_consensus_partition_soft_manhattan, dissimilarity = "manhattan", exponent = 1) set_cl_consensus_method("hard/manhattan", "partition", .cl_consensus_partition_hard_manhattan, dissimilarity = "manhattan", exponent = 1) set_cl_consensus_method("HM", "partition", .cl_consensus_partition_hard_manhattan, dissimilarity = "manhattan", exponent = 1) set_cl_consensus_method("GV1", "partition", .cl_consensus_partition_GV1, dissimilarity = "GV1", exponent = 2) set_cl_consensus_method("GV3", "partition", .cl_consensus_partition_GV3, dissimilarity = "comemberships", exponent = 2) set_cl_consensus_method("soft/symdiff", "partition", .cl_consensus_partition_soft_symdiff, dissimilarity = "symdiff", exponent = 1) set_cl_consensus_method("hard/symdiff", "partition", .cl_consensus_partition_hard_symdiff, dissimilarity = "symdiff", exponent = 1) set_cl_consensus_method("cophenetic", "hierarchy", .cl_consensus_hierarchy_cophenetic, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("euclidean", "hierarchy", .cl_consensus_hierarchy_cophenetic, dissimilarity = "euclidean", exponent = 2) set_cl_consensus_method("manhattan", "hierarchy", .cl_consensus_hierarchy_manhattan, dissimilarity = "manhattan", exponent = 1) set_cl_consensus_method("majority", "hierarchy", .cl_consensus_hierarchy_majority, dissimilarity = "symdiff", exponent = 1) ### * Dissimilarity Method Registration. cl_dissimilarity_methods_db <- new.env() get_cl_dissimilarity_methods <- function(type) get_methods_from_db(cl_dissimilarity_methods_db, type) get_cl_dissimilarity_method <- function(name, type) get_method_from_db(cl_dissimilarity_methods_db, type, name, gettextf("Invalid dissimilarity method '%s'.", name)) set_cl_dissimilarity_method <- function(name, type, definition, description, ...) put_method_into_db(cl_dissimilarity_methods_db, type, name, .structure(c(list(definition = definition, description = description), list(...)), class = "cl_dissimilarity_method")) set_cl_dissimilarity_method("euclidean", "partition", .cl_dissimilarity_partition_euclidean, "minimal Euclidean membership distance") set_cl_dissimilarity_method("manhattan", "partition", .cl_dissimilarity_partition_manhattan, "minimal Manhattan membership distance") set_cl_dissimilarity_method("comemberships", "partition", .cl_dissimilarity_partition_comemberships, "Euclidean comembership distance") set_cl_dissimilarity_method("symdiff", "partition", .cl_dissimilarity_partition_symdiff, "symmetric difference distance") set_cl_dissimilarity_method("Rand", "partition", .cl_dissimilarity_partition_Rand, "Rand distance") set_cl_dissimilarity_method("GV1", "partition", .cl_dissimilarity_partition_GV1, "Gordon-Vichi Delta_1 dissimilarity") set_cl_dissimilarity_method("BA/A", "partition", .cl_dissimilarity_partition_BA_A, "Boorman/Arabie minimum element moves distance") set_cl_dissimilarity_method("BA/C", "partition", .cl_dissimilarity_partition_BA_C, "Boorman/Arabie minimum lattice moves distance") set_cl_dissimilarity_method("BA/D", "partition", .cl_dissimilarity_partition_BA_D, "Boorman/Arabie pair-bonds distance") set_cl_dissimilarity_method("BA/E", "partition", .cl_dissimilarity_partition_BA_E, "Boorman/Arabie normalized information distance") set_cl_dissimilarity_method("VI", "partition", .cl_dissimilarity_partition_VI, "Variation of information") set_cl_dissimilarity_method("Mallows", "partition", .cl_dissimilarity_partition_Mallows, "Mallows dissimilarity") set_cl_dissimilarity_method("CSSD", "partition", .cl_dissimilarity_partition_CSSD, "Cluster Similarity Sensitive Distance") set_cl_dissimilarity_method("euclidean", "hierarchy", .cl_dissimilarity_hierarchy_euclidean, "Euclidean ultrametric distance") set_cl_dissimilarity_method("manhattan", "hierarchy", .cl_dissimilarity_hierarchy_manhattan, "Manhattan ultrametric distance") set_cl_dissimilarity_method("cophenetic", "hierarchy", .cl_dissimilarity_hierarchy_cophenetic, "cophenetic correlations") set_cl_dissimilarity_method("gamma", "hierarchy", .cl_dissimilarity_hierarchy_gamma, "rate of inversions") set_cl_dissimilarity_method("symdiff", "hierarchy", .cl_dissimilarity_hierarchy_symdiff, "symmetric difference distance") set_cl_dissimilarity_method("Chebyshev", "hierarchy", .cl_dissimilarity_hierarchy_Chebyshev, "Chebyshev distance") set_cl_dissimilarity_method("Lyapunov", "hierarchy", .cl_dissimilarity_hierarchy_Lyapunov, "Lyapunov distance") set_cl_dissimilarity_method("BO", "hierarchy", .cl_dissimilarity_hierarchy_BO, "Boorman/Olivier m_delta tree distance") set_cl_dissimilarity_method("spectral", "hierarchy", .cl_dissimilarity_hierarchy_spectral, "spectral ultrametric distance") ### * Agreement Method Registration. cl_agreement_methods_db <- new.env() get_cl_agreement_methods <- function(type) get_methods_from_db(cl_agreement_methods_db, type) get_cl_agreement_method <- function(name, type) get_method_from_db(cl_agreement_methods_db, type, name, gettextf("Invalid agreement method '%s'.", name)) set_cl_agreement_method <- function(name, type, definition, description, ...) put_method_into_db(cl_agreement_methods_db, type, name, .structure(c(list(definition = definition, description = description), list(...)), class = "cl_agreement_method")) set_cl_agreement_method("euclidean", "partition", .cl_agreement_partition_euclidean, "minimal euclidean membership distance") set_cl_agreement_method("manhattan", "partition", .cl_agreement_partition_manhattan, "minimal manhattan membership distance") set_cl_agreement_method("Rand", "partition", .cl_agreement_partition_Rand, "Rand index") set_cl_agreement_method("cRand", "partition", .cl_agreement_partition_cRand, "corrected Rand index") set_cl_agreement_method("NMI", "partition", .cl_agreement_partition_NMI, "normalized mutual information") set_cl_agreement_method("KP", "partition", .cl_agreement_partition_KP, "Katz-Powell index") set_cl_agreement_method("angle", "partition", .cl_agreement_partition_angle, "maximal angle between memberships") set_cl_agreement_method("diag", "partition", .cl_agreement_partition_diag, "maximal co-classification rate") set_cl_agreement_method("FM", "partition", .cl_agreement_partition_FM, "Fowlkes-Mallows index") set_cl_agreement_method("Jaccard", "partition", .cl_agreement_partition_Jaccard, "Jaccard index") set_cl_agreement_method("purity", "partition", .cl_agreement_partition_purity, "purity") set_cl_agreement_method("PS", "partition", .cl_agreement_partition_PS, "Prediction Strength") set_cl_agreement_method("euclidean", "hierarchy", .cl_agreement_hierarchy_euclidean, "euclidean ultrametric distance") set_cl_agreement_method("manhattan", "hierarchy", .cl_agreement_hierarchy_manhattan, "manhattan ultrametric distance") set_cl_agreement_method("cophenetic", "hierarchy", .cl_agreement_hierarchy_cophenetic, "cophenetic correlations") set_cl_agreement_method("angle", "hierarchy", .cl_agreement_hierarchy_angle, "angle between ultrametrics") set_cl_agreement_method("gamma", "hierarchy", .cl_agreement_hierarchy_gamma, "rate of inversions") clue/R/ultrametric.R0000644000175100001440000006365313435044702014116 0ustar hornikusers### * cl_ultrametric cl_ultrametric <- function(x, size = NULL, labels = NULL) { if(inherits(x, "cl_hierarchy")) { ## ## Strictly, not every hierarchy corresponds to an ultrametric. ## return(cl_ultrametric(.get_representation(x), size = size, labels = labels)) } else if(!inherits(x, "cl_ultrametric")) { ## Try using cophenetic(). ## This starts by coercing to hclust, which has methods for all ## currently supported hierarchical classification methods. ## To support others, either provide as.hclust methods for ## these, or make cl_ultrametric() generic and add methods. ## Or use the fact that in R >= 2.1.0, stats::cophenetic() is ## generic. out <- cophenetic(x) } else { out <- x if(is.null(labels)) labels <- attr(x, "Labels") } .cl_ultrametric_from_veclh(out, labels = labels, size = size) } .cl_ultrametric_from_veclh <- function(x, size = NULL, labels = NULL, meta = NULL) { if(.non_ultrametricity(x) > 0) stop("Not a valid ultrametric.") u <- cl_proximity(x, "Ultrametric distances", labels = labels, size = size, class = c("cl_ultrametric", "cl_dissimilarity", "cl_proximity", "dist")) if(!is.null(meta)) attr(u, "meta") <- meta u } ### * as.cl_ultrametric as.cl_ultrametric <- function(x) UseMethod("as.cl_ultrametric") as.cl_ultrametric.default <- function(x) { if(inherits(x, "cl_ultrametric")) x else if(is.atomic(x)) .cl_ultrametric_from_veclh(x) else cl_ultrametric(x) } as.cl_ultrametric.matrix <- function(x) .cl_ultrametric_from_veclh(x[row(x) > col(x)], labels = rownames(x)) ### * as.dendrogram.cl_ultrametric as.dendrogram.cl_ultrametric <- function(object, ...) as.dendrogram(as.hclust(object), ...) ### * as.hclust.cl_ultrametric as.hclust.cl_ultrametric <- function(x, ...) { ## Hierarchical clustering with single linkage gives the minimal ## ultrametric dominated by a dissimilarity, see e.g. Bock (1974, ## Theorem 39.2). Hence, hclust(method = "single") on an ## ultrametric gives the hclust representation of the associated ## dendrogram. hclust(x, "single") } ### * cophenetic.cl_ultrametric cophenetic.cl_ultrametric <- function(x) as.dist(x) ### * plot.cl_ultrametric plot.cl_ultrametric <- function(x, ...) plot(as.dendrogram(x), ...) ### * ls_fit_ultrametric ls_fit_ultrametric <- function(x, method = c("SUMT", "IP", "IR"), weights = 1, control = list()) { if(inherits(x, "cl_ultrametric")) { return(.cl_ultrametric_with_meta_added(x, list(objval = 0))) } else if(is.cl_ensemble(x) || is.list(x)) { ## Might be given a list/ensemble of object dissimilarities. ## In this case, compute the suitably weighted average and ## proceed. if(length(x) == 0L) stop("Given ensemble contains no dissimilarities.") ## Let's be nice as usual ... ind <- !vapply(x, .has_object_dissimilarities, NA) if(any(ind)) x[ind] <- lapply(x[ind], as.dist) x <- .weighted_mean_of_object_dissimilarities(x, control$weights) } else if(!inherits(x, "dist")) x <- as.dist(x) ## Catch some special cases right away. if(attr(x, "Size") <= 2L) return(.cl_ultrametric_with_meta_added(as.cl_ultrametric(x), list(objval = 0))) if(.non_ultrametricity(x, max = TRUE) == 0) return(.cl_ultrametric_with_meta_added(as.cl_ultrametric(x), list(objval = 0))) ## Handle weights. ## This is somewhat tricky ... if(is.matrix(weights)) { weights <- as.dist(weights) if(length(weights) != length(x)) stop("Argument 'weights' must be compatible with 'x'.") } else weights <- rep_len(weights, length(x)) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") method <- match.arg(method) switch(method, SUMT = .ls_fit_ultrametric_by_SUMT(x, weights, control), IP = { .ls_fit_ultrametric_by_iterative_projection(x, weights, control) }, IR = { .ls_fit_ultrametric_by_iterative_reduction(x, weights, control) }) } ### ** .ls_fit_ultrametric_by_SUMT .ls_fit_ultrametric_by_SUMT <- function(x, weights = 1, control = list()) { ## Fit an ultrametric to a dissimilarity by minimizing euclidean ## dissimilarity subject to the ultrametric constraint, using the ## sequential algorithm of de Soete (1984) with a slight change: we ## try to ensure that what we obtain satisfies the constraints ## "exactly" rather than approximately. We (currently?) do that via ## rounding ... ## ## This fits and hence returns an ultrametric, *not* the hierarchy ## corresponding to the ultrametric. ## w <- weights / sum(weights) ## Control parameters: ## nruns, nruns <- control$nruns ## start. start <- control$start ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } ## If x is an ultrametric, or satisfies the ultrametricity ## constraints, return it. if(inherits(x, "cl_ultrametric") || (.non_ultrametricity(x, max = TRUE) == 0)) return(.cl_ultrametric_with_meta_added(as.cl_ultrametric(x), list(objval = 0))) ## For the time being, use a simple minimizer. n <- attr(x, "Size") labels <- attr(x, "Labels") ## Handle missing values in x along the lines of de Soete (1984): ## set the corresponding weights to 0, and impute by the weighted ## mean. ind <- which(is.na(x)) if(any(ind)) { w[ind] <- 0 x[ind] <- weighted.mean(x, w, na.rm = TRUE) } ## We follow de Soete's notation, and use the veclh's (vector of ## lower half, in S the same as x[lower.tri(x)]) of the respective ## proximity objects. L <- function(d) sum(w * (x - d) ^ 2) P <- .make_penalty_function_ultrametric(n) grad_L <- function(d) 2 * w * (d - x) grad_P <- .make_penalty_gradient_ultrametric(n) if(is.null(start)) { ## Initialize by "random shaking". Use sd() for simplicity. start <- replicate(nruns, x + rnorm(length(x), sd = sd(x) / sqrt(3)), simplify = FALSE) } ## And now ... out <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control)) d <- .ultrametrify(out$x) meta <- list(objval = L(d)) .cl_ultrametric_from_veclh(d, n, labels, meta) } .make_penalty_function_ultrametric <- function(n) function(d) { ## Smooth penalty function measuring the extent of violation of ## the ultrametricity constraint. Also ensure nonnegativity ... (.non_ultrametricity(.symmetric_matrix_from_veclh(d, n)) + sum(pmin(d, 0) ^ 2)) } .make_penalty_gradient_ultrametric <- function(n) function(d) { gr <- matrix(.C(C_deviation_from_ultrametricity_gradient, as.double(.symmetric_matrix_from_veclh(d, n)), as.integer(n), gr = double(n * n))$gr, n, n) gr[row(gr) > col(gr)] + 2 * sum(pmin(d, 0)) } ### ** .ls_fit_ultrametric_by_iterative_projection ## ## Functions ## .ls_fit_ultrametric_by_iterative_projection() ## .ls_fit_ultrametric_by_iterative_reduction() ## are really identical apart from the name of the C routine they call. ## (But will this necessarily always be the case in the future?) ## Merge maybe ... ## .ls_fit_ultrametric_by_iterative_projection <- function(x, weights = 1, control = list()) { if(any(diff(weights) != 0)) warning("Non-identical weights currently not supported.") labels <- attr(x, "Labels") n <- attr(x, "Size") x <- as.matrix(x) ## Control parameters: ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 10000L ## nruns, nruns <- control$nruns ## order, order <- control$order ## tol, tol <- control$tol if(is.null(tol)) tol <- 1e-8 ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle order and nruns. if(!is.null(order)) { if(!is.list(order)) order <- as.list(order) if(!all(vapply(order, function(o) all(sort(o) == seq_len(n)), NA))) stop("All given orders must be valid permutations.") } else { if(is.null(nruns)) nruns <- 1L order <- replicate(nruns, sample(n), simplify = FALSE) } ## ## Adjust in case support for non-identical weights is added. L <- function(d) sum((x - d) ^ 2) ## d_opt <- NULL v_opt <- Inf for(run in seq_along(order)) { if(verbose) message(gettextf("Iterative projection run: %d", run)) d <- .C(C_ls_fit_ultrametric_by_iterative_projection, as.double(x), as.integer(n), as.integer(order[[run]] - 1L), as.integer(maxiter), iter = integer(1L), as.double(tol), as.logical(verbose))[[1L]] v <- L(d) if(v < v_opt) { v_opt <- v d_opt <- d } } d <- .ultrametrify(as.dist(matrix(d_opt, n))) meta <- list(objval = L(d)) .cl_ultrametric_from_veclh(d, n, labels, meta) } ### ** .ls_fit_ultrametric_by_iterative_reduction .ls_fit_ultrametric_by_iterative_reduction <- function(x, weights = 1, control = list()) { if(any(diff(weights) != 0)) warning("Non-identical weights currently not supported.") labels <- attr(x, "Labels") n <- attr(x, "Size") x <- as.matrix(x) ## Control parameters: ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 10000L ## nruns, nruns <- control$nruns ## order, order <- control$order ## tol, tol <- control$tol if(is.null(tol)) tol <- 1e-8 ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Handle order and nruns. if(!is.null(order)) { if(!is.list(order)) order <- as.list(order) if(!all(vapply(order, function(o) all(sort(o) == seq_len(n)), NA))) stop("All given orders must be valid permutations.") } else { if(is.null(nruns)) nruns <- 1L order <- replicate(nruns, sample(n), simplify = FALSE) } ## ## Adjust in case support for non-identical weights is added. L <- function(d) sum((x - d) ^ 2) ## d_opt <- NULL v_opt <- Inf for(run in seq_along(order)) { if(verbose) message(gettextf("Iterative reduction run: %d", run)) d <- .C(C_ls_fit_ultrametric_by_iterative_reduction, as.double(x), as.integer(n), as.integer(order[[run]] - 1L), as.integer(maxiter), iter = integer(1L), as.double(tol), as.logical(verbose))[[1L]] v <- L(d) if(v < v_opt) { v_opt <- v d_opt <- d } } d <- .ultrametrify(as.dist(matrix(d_opt, n))) meta <- list(objval = L(d)) .cl_ultrametric_from_veclh(d, n, labels, meta) } ### * Ultrametric Target Fitters. ### ** ls_fit_ultrametric_target ls_fit_ultrametric_target <- function(x, y, weights = 1) { fitter <- if(identical(weights, 1)) # Default. function(x, w) mean(x) else function(x, w) weighted.mean(x, w) distfun <- function(x, u, w) sqrt(sum(w * (x - u) ^ 2)) .fit_ultrametric_target(x, y, weights, fitter, distfun) } ### ** l1_fit_ultrametric_target l1_fit_ultrametric_target <- function(x, y, weights = 1) { fitter <- if(identical(weights, 1)) # Default. function(x, w) median(x) else function(x, w) weighted_median(x, w) distfun <- function(x, u, w) sum(w * abs(x - u)) .fit_ultrametric_target(x, y, weights, fitter, distfun) } ### ** .fit_ultrametric_target .fit_ultrametric_target <- function(x, y, w, fitter, distfun = NULL) { w <- .handle_weights_for_ultrametric_target_fitters(w, x) ## The documentation says that x should inherit from dist, so coerce ## to this if needed but if not a matrix (as we will coerce back to ## a matrix right away). if(!inherits(x, "dist") && !is.matrix(x)) x <- as.dist(x) x <- as.matrix(x) y <- as.hclust(y) n <- length(y$order) ilist <- vector("list", n) out <- matrix(0, n, n) mat <- xlist <- wlist <- vector("list", n - 1L) for(i in seq_len(n - 1L)) { inds <- y$merge[i, ] ids1 <- if(inds[1L] < 0) -inds[1L] else ilist[[inds[1L]]] ids2 <- if(inds[2L] < 0) -inds[2L] else ilist[[inds[2L]]] ilist[[i]] <- c(ids1, ids2) mat[[i]] <- cbind(rep.int(ids1, rep.int(length(ids2), length(ids1))), rep.int(ids2, length(ids1))) xlist[[i]] <- x[mat[[i]]] wlist[[i]] <- w[mat[[i]]] } values <- pava(xlist, wlist, fitter) for(i in seq_len(n - 1L)) out[mat[[i]]] <- values[i] rownames(out) <- y$labels u <- as.cl_ultrametric(out + t(out)) if(!is.null(distfun)) attr(u, "meta") <- list(objval = distfun(as.dist(x), u, as.dist(w))) u } ### ** .handle_weights_for_ultrametric_target_fitters .handle_weights_for_ultrametric_target_fitters <- function(weights, x) { ## Handle weights for the ultrametric target fitters. ## This is somewhat tricky ... if(is.matrix(weights)) { if(any(dim(weights) != attr(x, "Size"))) stop("Argument 'weights' must be compatible with 'x'.") } else weights <- as.matrix(.dist_from_vector(rep_len(weights, length(x)))) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") weights } ### l1_fit_ultrametric l1_fit_ultrametric <- function(x, method = c("SUMT", "IRIP"), weights = 1, control = list()) { if(inherits(x, "cl_ultrametric")) return(.cl_ultrametric_with_meta_added(x, list(objval = 0))) if(!inherits(x, "dist")) x <- as.dist(x) ## Catch some special cases right away. if(attr(x, "Size") <= 2L) return(.cl_ultrametric_with_meta_added(as.cl_ultrametric(x), list(objval = 0))) if(.non_ultrametricity(x, max = TRUE) == 0) return(.cl_ultrametric_with_meta_added(as.cl_ultrametric(x), list(objval = 0))) ## Handle weights. ## This is somewhat tricky ... if(is.matrix(weights)) { weights <- as.dist(weights) if(length(weights) != length(x)) stop("Argument 'weights' must be compatible with 'x'.") } else weights <- rep_len(weights, length(x)) if(any(weights < 0)) stop("Argument 'weights' has negative elements.") if(!any(weights > 0)) stop("Argument 'weights' has no positive elements.") method <- match.arg(method) switch(method, SUMT = .l1_fit_ultrametric_by_SUMT(x, weights, control), IRIP = .l1_fit_ultrametric_by_IRIP(x, weights, control)) } ### ** .l1_fit_ultrametric_by_SUMT .l1_fit_ultrametric_by_SUMT <- function(x, weights = 1, control = list()) { ## Try a SUMT with "pseudo-gradients". w <- weights / sum(weights) ## Control parameters: ## gradient, gradient <- control$gradient if(is.null(gradient)) gradient <- TRUE ## nruns, nruns <- control$nruns ## start. start <- control$start ## Handle start values and number of runs. if(!is.null(start)) { if(!is.list(start)) { ## Be nice to users. start <- list(start) } } else if(is.null(nruns)) { ## Use nruns only if start is not given. nruns <- 1L } ## For the time being, use a simple minimizer. n <- attr(x, "Size") labels <- attr(x, "Labels") L <- function(d) sum(w * abs(d - x)) P <- .make_penalty_function_ultrametric(n) if(gradient) { grad_L <- function(d) w * sign(d - x) grad_P <- .make_penalty_gradient_ultrametric(n) } else grad_L <- grad_P <- NULL if(is.null(start)) { ## Initialize by "random shaking". Use sd() for simplicity. start <- replicate(nruns, x + rnorm(length(x), sd = sd(x) / sqrt(3)), simplify = FALSE) } ## And now ... out <- sumt(start, L, P, grad_L, grad_P, method = control$method, eps = control$eps, q = control$q, verbose = control$verbose, control = as.list(control$control)) d <- .ultrametrify(out$x) meta <- list(objval = L(d)) .cl_ultrametric_from_veclh(d, n, labels, meta) } ### ** .l1_fit_ultrametric_by_IRIP .l1_fit_ultrametric_by_IRIP <- function(x, weights = 1, control = list()) { ## An attempt of implementing "Iteratively Reweighted Iterative ## Projection" as described in Smith (2000, 2001), Journal of ## Classification. Note that this suggests using the Iterative ## Projection of Hubert and Arabie (1995), which we cannot as we ## have not (yet?) implemented this for the weighted case. Hence, ## we use our SUMT least squares ultrametric fitter instead. ## ## However, we never got this to converge properly ... w <- weights / sum(weights) ## Control parameters: ## MIN, MIN <- control$MIN if(is.null(MIN)) MIN <- 1e-3 ## (A rather small cut-off which worked best in the cases we tried.) ## eps, eps <- control$eps if(is.null(eps)) eps <- 1e-6 ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 100L ## reltol, reltol <- control$reltol if(is.null(reltol)) reltol <- 1e-6 ## start, start <- control$start ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") n <- attr(x, "Size") labels <- attr(x, "Labels") L <- function(d) sum(w * abs(x - d)) ## Initialize by "random shaking" as for the L2 SUMT, but perhaps we ## should not do this? [Or do it differently?] u <- if(is.null(start)) x + rnorm(length(x), sd = sd(x) / 3) else start ## (No multiple runs for the time being.) L_new <- L(u) iter <- 1L while(iter <= maxiter) { if(verbose) message(gettextf("Outer iteration: %d", iter)) L_old <- L_new u_old <- u weights <- w / pmax(abs(u - x), MIN) u <- .ls_fit_ultrametric_by_SUMT(x, weights = weights, control = as.list(control$control)) ## Use some control arguments lateron ... L_new <- L(u) delta_L <- L_old - L_new delta_u <- max(abs(u_old - u)) if(verbose) message(gettextf("Change: u: %g L: %g", delta_u, delta_L)) if((delta_u < eps) || ((delta_L >= 0) && (delta_L <= reltol * (abs(L_old) + reltol)))) break iter <- iter + 1L } d <- .ultrametrify(u) meta <- list(objval = L(d), status = as.integer(iter == maxiter)) .cl_ultrametric_from_veclh(d, n, labels, meta) } ## * ls_fit_sum_of_ultrametrics ls_fit_sum_of_ultrametrics <- function(x, nterms = 1, weights = 1, control = list()) { if(!inherits(x, "dist")) x <- as.dist(x) ## We could catch some special cases right away: if x already is an ## ultrametric then the fit would be a list with x and nterms - 1 ## zero ultrametrics ... ## Control parameters: ## eps, eps <- control$eps if(is.null(eps)) eps <- 1e-6 ## maxiter, maxiter <- control$maxiter if(is.null(maxiter)) maxiter <- 100L ## method, method <- control$method if(is.null(method)) method <- "SUMT" ## reltol, reltol <- control$reltol if(is.null(reltol)) reltol <- 1e-6 ## verbose. verbose <- control$verbose if(is.null(verbose)) verbose <- getOption("verbose") ## Do this at last. control <- as.list(control$control) ## And be nice ... if(identical(method, "SUMT") && is.null(control$nruns)) control$nruns <- 10L L <- function(u) sum((x - rowSums(matrix(unlist(u), ncol = nterms))) ^ 2) ## Init. u <- rep.int(list(as.cl_ultrametric(0 * x)), nterms) L_new <- L(u) ## Loop. iter <- 1L while(iter <= maxiter) { if(verbose) message(gettextf("Iteration: %d", iter)) L_old <- L_new delta_u <- 0 for(i in seq_len(nterms)) { if(verbose) message(gettextf("Term: %d", i)) u_old <- u[[i]] ## Compute residual r = x - \sum_{j: j \ne i} u(j) r <- x - rowSums(matrix(unlist(u[-i]), ncol = nterms - 1L)) ## Fit residual. u[[i]] <- ls_fit_ultrametric(r, method, weights, control) ## Accumulate change. change <- max(abs(u[[i]] - u_old)) if(verbose) message(gettextf("Change: %g", change)) delta_u <- max(delta_u, change) } L_new <- L(u) delta_L <- L_old - L_new if(verbose) message(gettextf("Overall change: u: %g L: %g\n", delta_u, delta_L)) if((delta_u < eps) || ((delta_L >= 0) && (delta_L <= reltol * (abs(L_old) + reltol)))) break iter <- iter + 1L } .structure(u, objval = L_new, status = as.integer(iter == maxiter)) } ### * as.dist.hclust ## Using hclust() with methods 'median' or 'centroid' typically gives ## reversals and hence not valid hierarchies, i.e., distances which do ## not satisfy the ultrametricity conditions. The distances can be ## obtained via cophenetic(), but ls_fit_ultrametric() prefers using ## as.dist() [as arguably more appropriate] which in turn can be made to ## "work" by providing as.matrix() methods [bypassing the need to handle ## the extra arguments 'diag' and 'upper' for as.dist()]. as.matrix.hclust <- function(x, ...) as.matrix(cophenetic(x)) ### * .non_ultrametricity .non_ultrametricity <- function(x, max = FALSE) { if(!is.matrix(x)) x <- .symmetric_matrix_from_veclh(x) .C(C_deviation_from_ultrametricity, as.double(x), as.integer(nrow(x)), fn = double(1L), as.logical(max))$fn } ### * .cl_ultrametric_from_classes .cl_ultrametric_from_classes <- function(x) { ## Compute an ultrametric from a hierarchy of classes (i.e., an ## n-tree). labels <- attr(x, "labels") ## Ensure we have no duplicates. x <- x[!duplicated(x)] ## .get_classes_in_hierarchy() orders according to cardinality, but ## a consensus method may forget to ... x[] <- x[order(lengths(x))] ## Get the objects (unique codes in the classes). objects <- sort(unique(unlist(x))) ## (Could also look at the classes of length 1.) ## Recursively compute the heights of the classes. heights <- double(length = length(x)) for(i in which(lengths(x) > 1L)) { ## Find the relevant classes. j <- sapply(x[seq_len(i - 1L)], function(s) all(s %in% x[[i]])) heights[i] <- max(heights[j]) + 1 } ## Next, create an incidence matrix (objects by classes). incidences <- sapply(x, function(s) objects %in% s) ## Now that we have the heights and incidences, we can compute ## distances, using the idea that ## distance(i, j) = min(height(A): A contains i and j) n <- length(objects) d <- matrix(0, n, n) for(i in objects) d[i, ] <- heights[apply((rep(incidences[i, ], each = n) & incidences), 1L, which.max)] dimnames(d) <- rep.int(list(labels), 2L) as.cl_ultrametric(d) } ### * .cl_ultrametric_with_meta_added .cl_ultrametric_with_meta_added <- function(x, meta = NULL) { ## An alternative to adding a 'meta' argument to cl_ultrametric(). attr(x, "meta") <- meta x } ### .ultrametrify .ultrametrify <- function(x) { ## Ensure ultrametricity. ## In earlier versions, function ## .cl_ultrametric_from_ultrametric_approximation() tried rounding ## to non-ultrametric significance, using ## round(x, floor(abs(log10(.non_ultrametricity(x, max = TRUE))))) ## which is nice but does not guarantee ultrametricity (and may ## result in poorer approximations than what we use now). ## Hence, let us use single linkage hierarchical clustering which ## gives the best dominated ultrametric approximation. cophenetic(hclust(.dist_from_vector(x), "single")) } ### Local variables: *** ### mode: outline-minor *** ### outline-regexp: "### [*]+" *** ### End: *** clue/R/ensemble.R0000644000175100001440000001567013435044575013361 0ustar hornikuserscl_ensemble <- function(..., list = NULL) { clusterings <- c(list(...), list) if(!length(clusterings)) { ## Return an empty cl_ensemble. ## In this case, we cannot additionally know whether it contains ## partitions or hierarchies ... attr(clusterings, "n_of_objects") <- as.integer(NA) class(clusterings) <- "cl_ensemble" return(clusterings) } ## Previously, we used to require that the elements of the ensemble ## either all be partitions, or all be hierarchies. We no longer do ## this, as it makes sense to also allow e.g. object dissimilarities ## (raw "dist" objects or additive distances) as elements (e.g., ## when computing proximities), and it is rather cumbersome to ## decide in advance which combinations of elements might be useful ## and hence should be allowed. All we enforce is that all elements ## correspond to the same number of objects (as we typically cannot ## verify that they relate to the *same* objects). For "pure" ## ensembles of partitions or hierarchies we add additional class ## information. if(all(vapply(clusterings, is.cl_partition, NA))) class(clusterings) <- c("cl_partition_ensemble", "cl_ensemble") else if(all(vapply(clusterings, is.cl_dendrogram, NA))) class(clusterings) <- c("cl_dendrogram_ensemble", "cl_hierarchy_ensemble", "cl_ensemble") else if(all(vapply(clusterings, is.cl_hierarchy, NA))) class(clusterings) <- c("cl_hierarchy_ensemble", "cl_ensemble") else class(clusterings) <- "cl_ensemble" n <- sapply(clusterings, n_of_objects) if(any(diff(n))) stop("All elements must have the same number of objects.") attr(clusterings, "n_of_objects") <- as.integer(n[1L]) clusterings } is.cl_ensemble <- function(x) inherits(x, "cl_ensemble") ## ## In the old days, kmeans() results were unclassed lists, hence such ## objects were taken as representing a single clustering. Nowadays, we ## take these as lists of clusterings. as.cl_ensemble <- function(x) { if(is.cl_ensemble(x)) x else if(is.list(x) && !is.object(x)) cl_ensemble(list = x) else cl_ensemble(x) } ## c.cl_ensemble <- function(..., recursive = FALSE) { clusterings <- unlist(lapply(list(...), as.cl_ensemble), recursive = FALSE) cl_ensemble(list = clusterings) } "[.cl_ensemble" <- function(x, i) { ## Make subscripting empty ensembles a noop. if(length(x) == 0L) return(x) cl_ensemble(list = NextMethod("[")) } rep.cl_ensemble <- function(x, times, ...) cl_ensemble(list = NextMethod("rep")) print.cl_partition_ensemble <- function(x, ...) { msg <- sprintf(ngettext(length(x), "An ensemble of %d partition of %d objects.", "An ensemble of %d partitions of %d objects."), length(x), n_of_objects(x)) writeLines(strwrap(msg)) invisible(x) } Summary.cl_partition_ensemble <- function(..., na.rm = FALSE) { ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) if(!ok) stop(gettextf("Generic '%s' not defined for \"%s\" objects.", .Generic, .Class), domain = NA) args <- list(...) ## Combine the given partition ensembles. x <- do.call(c, args) switch(.Generic, "min" = cl_meet(x), "max" = cl_join(x), "range" = cl_ensemble(min = cl_meet(x), max = cl_join(x))) } print.cl_dendrogram_ensemble <- function(x, ...) { msg <- sprintf(ngettext(length(x), "An ensemble of %d dendrogram of %d objects.", "An ensemble of %d dendrograms of %d objects."), length(x), n_of_objects(x)) writeLines(strwrap(msg)) invisible(x) } print.cl_hierarchy_ensemble <- function(x, ...) { msg <- sprintf(ngettext(length(x), "An ensemble of %d hierarchy of %d objects.", "An ensemble of %d hierarchies of %d objects."), length(x), n_of_objects(x)) writeLines(strwrap(msg)) invisible(x) } print.cl_ensemble <- function(x, ...) { writeLines(sprintf(ngettext(length(x), "An ensemble with %d element.", "An ensemble with %d elements."), length(x))) invisible(x) } plot.cl_ensemble <- function(x, ..., main = NULL, layout = NULL) { if(!is.cl_ensemble(x)) stop("Wrong class.") ## What we can definitely plot is are cl_addtree, cl_dendrogram and ## cl_ultrametric objects. (We could also add simple methods for ## plotting raw dissimilarities, but of course seriation::dissplot() ## would be the thing to use.) What we cannot reasonably plot is ## partitions (in particular, as these do not know about the ## underlying dissimilarities. But then we could perhaps provide ## silhoutte plots etc for ensembles of partitions ... ## ## Think about this. ## ## So let us check for the things we can plot. ## (Note that currently there is neither is.cl_ultrametric() nor ## is.cl_addtree().) ok <- vapply(x, function(e) (is.cl_dendrogram(e) || inherits(e, c("cl_addtree", "cl_ultrametric"))), NA) if(!all(ok)) stop(gettextf("Plotting not available for elements %s of the ensemble.", paste(which(!ok), collapse = " ")), domain = NA) ## Prefer dendrogram plot methods to those for hclust objects. ind <- vapply(x, is.cl_dendrogram, NA) if(any(ind)) x[ind] <- lapply(x, as.cl_dendrogram) ## Now the usual layouting ... same as for plotting relation ## ensembles. ## Number of elements. n <- length(x) ## Layout. byrow <- TRUE if(is.null(layout)) { nc <- ceiling(sqrt(n)) nr <- ceiling(n / nc) } else { layout <- c(as.list(layout), byrow)[seq_len(3)] if(is.null(names(layout))) names(layout) <- c("nr", "nc", "byrow") nr <- layout[["nr"]] nc <- layout[["nc"]] byrow <- layout[["byrow"]] } op <- if(byrow) par(mfrow = c(nr, nc)) else par(mfcol = c(nr, nc)) on.exit(par(op)) ## Try recycling main (might want the same for others as well). if(!is.list(main)) { main <- if(is.null(main)) vector("list", length = n) else rep.int(as.list(main), n) } for(i in seq_along(x)) plot(x[[i]], main = main[[i]], ...) } unique.cl_ensemble <- function(x, incomparables = FALSE, ...) cl_ensemble(list = NextMethod("unique")) .cl_ensemble_type <- function(x) { if(inherits(x, "cl_partition_ensemble")) "partition" else if(inherits(x, "cl_hierarchy_ensemble")) "hierarchy" else NULL } clue/R/AAA.R0000644000175100001440000000037411304023136012123 0ustar hornikusers## Things which must come first in the package code. ### * Internal utilities. .false <- function(x) FALSE .true <- function(x) TRUE ## A fast version of structure(). .structure <- function(x, ...) `attributes<-`(x, c(attributes(x), list(...))) clue/R/margin.R0000644000175100001440000000060511304023136013013 0ustar hornikuserscl_margin <- function(x) { if(is.cl_hard_partition(x)) out <- rep.int(1, n_of_objects(x)) else if(is.cl_partition(x)) { x <- cl_membership(x) i <- seq_len(nrow(x)) j <- cbind(i, max.col(x)) out <- x[j] x[j] <- 0 out <- out - x[cbind(i, max.col(x))] } else stop("Argument 'x' must be a partition.") out } clue/R/medoid.R0000644000175100001440000001561514503541657013027 0ustar hornikusers### * cl_medoid cl_medoid <- function(x, method = "euclidean") { ## ## In principle we can get the same using pam(k = 1)$medoids. ## clusterings <- as.cl_ensemble(x) if(!length(clusterings)) stop("Cannot compute medoid of empty ensemble.") dissimilarities <- as.matrix(cl_dissimilarity(clusterings, method = method)) clusterings[[which.min(rowSums(dissimilarities))]] } ### * cl_pam cl_pam <- function(x, k, method = "euclidean", solver = c("pam", "kmedoids")) { clusterings <- as.cl_ensemble(x) if(!length(clusterings)) stop("Cannot compute medoid partition of empty ensemble.") ## Actually, we should have at least k distinct elements in the ## ensemble ... make_cl_pam <- function(class_ids, medoid_ids, medoids, criterion, description) .structure(list(cluster = class_ids, medoid_ids = medoid_ids, prototypes = medoids, criterion = criterion, description = description), class = "cl_pam") if(k == 1L) { ## Simplify matters if a global medoid is sought. dissimilarities <- cl_dissimilarity(clusterings, method = method) description <- attr(dissimilarities, "description") dissimilarities <- as.matrix(dissimilarities) row_sums <- rowSums(dissimilarities) medoid_id <- which.min(row_sums) criterion <- row_sums[medoid_id] return(make_cl_pam(as.cl_class_ids(seq_along(clusterings)), medoid_id, clusterings[medoid_id], criterion, description)) } solver <- match.arg(solver) ## Argh. We really want to run k-medoids for the unique elements of ## the ensemble, but pam() only works for symmetric dissimilarties. ## As computing cluster dissimilarities is typically expensive, use ## the unique elements for doing so in any case. values <- unique(clusterings) ## Positions of ensemble members in the unique values. positions <- match(clusterings, values) ## Dissimilarities between unique values. dissimilarities <- cl_dissimilarity(values, method = method) description <- attr(dissimilarities, "description") dissimilarities <- as.matrix(dissimilarities) ## For pam(), we need the dissimilarities for all objects. if(solver == "pam") { dissimilarities <- dissimilarities[positions, positions] party <- pam(as.dist(dissimilarities), k) class_ids <- cl_class_ids(party) medoid_ids <- cl_medoid_ids(party) medoids <- clusterings[medoid_ids] criterion <- sum(dissimilarities[cbind(seq_along(class_ids), medoid_ids[class_ids])]) } else { ## Counts of unique values. counts <- tabulate(positions) ## Weigh according to the counts. Should be straightforward to ## add "case weights" as well ... dissimilarities <- counts * dissimilarities ## Now partition. party <- kmedoids(dissimilarities, k) ## And build the solution from this ... criterion <- party$criterion ## First, things for the unique values. medoid_ids <- cl_medoid_ids(party) medoids <- values[medoid_ids] class_ids <- cl_class_ids(party) ## Second, things for all objects. class_ids <- class_ids[positions] medoid_ids <- match(medoid_ids, positions) } make_cl_pam(class_ids, medoid_ids, medoids, criterion, description) } print.cl_pam <- function(x, ...) { class_ids <- cl_class_ids(x) fmt <- "A k-medoid partition of a cluster ensemble with %d elements into %d classes (dissimilarity measure: %s)." writeLines(c(strwrap(gettextf(fmt, n_of_objects(x), n_of_classes(x), x$description)))) writeLines(gettext("Class ids:")) print(class_ids, ...) writeLines(gettext("Criterion:")) print(x$criterion, ...) invisible(x) } ### * cl_medoid_ids ## Little helper, internal for the time being ... cl_medoid_ids <- function(x) UseMethod("cl_medoid_ids") cl_medoid_ids.cl_pam <- function(x) x$medoid_ids cl_medoid_ids.kmedoids <- function(x) x$medoid_ids cl_medoid_ids.clara <- function(x) x$i.med cl_medoid_ids.pam <- function(x) x$id.med ### * kmedoids kmedoids <- function(x, k) { ## ## For the time being, 'x' is assumed a dissimilarity object or a ## matrix of dissimilarities. ## Let's worry about the interface later. ## x <- as.matrix(x) n <- nrow(x) ## Use the formulation in Gordon & Vichi (1998), Journal of ## Classification, [P4'], page 279, with variables c(vec(X), z), but ## with rows and cols interchanged (such that x_{ij} is one iff o_i ## has medoid o_j, and z_j is one iff o_j is a medoid). make_constraint_mat <- function(n) { nsq <- n * n rbind(cbind(kronecker(rbind(rep.int(1, n)), diag(1, n)), matrix(0, n, n)), cbind(diag(1, nsq), kronecker(diag(1, n), rep.int(-1, n))), c(double(nsq), rep.int(1, n)), cbind(matrix(0, n, nsq), diag(1, n))) } make_constraint_dir <- function(n) rep.int(c("=", "<=", "=", "<="), c(n, n * n, 1, n)) make_constraint_rhs <- function(n, k) rep.int(c(1, 0, k, 1), c(n, n * n, 1, n)) ## ## We could try a relaxation without integrality constraints first, ## which seems to "typically work" (and should be faster). To test ## for integrality, use something like ## if(identical(all.equal(y$solution, round(y$solution)), TRUE)) ## y <- lpSolve::lp("min", c(c(x), double(n)), make_constraint_mat(n), make_constraint_dir(n), make_constraint_rhs(n, k), int.vec = seq_len(n * (n + 1))) ## Now get the class ids and medoids. ind <- which(matrix(y$solution[seq_len(n * n)], n) > 0, arr.ind = TRUE) medoid_ids <- unique(ind[, 2L]) class_ids <- seq_len(n) class_ids[ind[, 1L]] <- match(ind[, 2L], medoid_ids) .structure(list(cluster = class_ids, medoid_ids = medoid_ids, criterion = y$objval), class = "kmedoids") } print.kmedoids <- function(x, ...) { fmt <- "A k-medoids clustering of %d objects into %d clusters." writeLines(gettextf(fmt, n_of_objects(x), n_of_classes(x))) writeLines(gettext("Medoid ids:")) print(cl_medoid_ids(x), ...) writeLines(gettext("Class ids:")) print(unclass(cl_class_ids(x)), ...) writeLines(gettext("Criterion:")) print(x$criterion, ...) invisible(x) } clue/MD50000644000175100001440000001136314503545506011543 0ustar hornikusersb60855b1f2c66bca773e5e81d2b18877 *DESCRIPTION 8d6739bf3e0ef6e7f5e5e1f6f6f87989 *NAMESPACE 281c7577f564a5acbecf046c5d1b8e64 *R/AAA.R 3cd212ef14c9566294542d691268fd5a *R/addtree.R 5ca7bd63f1ed85f171358c12fcf08e53 *R/agreement.R 61f26eec5666c409d3a7369f9cc0c99a *R/bag.R cd56914218fa9922aba0f76ff8b94909 *R/boot.R 74c617065ccf4f72df1353534f85da75 *R/classes.R e4c06eac28291bc97fb2e40603f3e23d *R/consensus.R f03ed842ca3417fb555be3254025d412 *R/dissimilarity.R c8a21520e911951d95d7ebd74e113265 *R/ensemble.R f4bbabdccc0b0dc31dbf14373ded5d11 *R/fuzziness.R 5999d867614d17cd53a043cbd99703c9 *R/hierarchy.R d67f188882f5aae752df482d3473fbd0 *R/lattice.R 285f76623c207f44342d7d1ca33d07e8 *R/lsap.R d10944e1875825af11bcea65571432fc *R/margin.R 4fd82d58960235a35f20d2b964149caf *R/medoid.R a3dccf831a311ed068578f817f38161e *R/membership.R 27369e3ebfc5ade758ebb2e49bb213fc *R/objects.R 4b8e8ee574a015903622e264e7560aa8 *R/partition.R 00c4dfcc2d401d810d70f246b7628f6b *R/pava.R 6131a8ffa97003764405701373a3bd48 *R/pclust.R fc4d256afc4ea0c926fe6e288f20ec65 *R/predict.R 44b2e289ec1ed4ea042eccd8816080c5 *R/prototypes.R 5eabc5a234802b0f5a9f4c244ebe9aa9 *R/proximity.R f1a133ffc362372bc24ff24581964b1e *R/registration.R 69049e632bf64e2a11ed5b4f0c276570 *R/sumt.R 8cfa16132f28d693fcd03d396a678deb *R/tabulate.R f415cbecc8d1694bca125998db11a2ae *R/ultrametric.R 6a62f57555cae254f1f7b3ed5d9f152c *R/utilities.R e869958a1b430996c06e7634afa0a1b6 *R/validity.R 7080893e02c49cd296d4424b9be55069 *build/partial.rdb 7eb4855792caba22446275447855efbc *build/vignette.rds fff14190ebacd7ba531db8d58907f7e0 *data/CKME.rda ca590384c88e6b34a5b68fb976070151 *data/Cassini.rda 1e016c3b4fb323a298cdf2cc058693cb *data/GVME.rda 50190110b43c99b3adf3ab261337f567 *data/GVME_Consensus.rda 159a35548f33aca08afd2ba8f1a2c654 *data/Kinship82.rda d6ee8c92e044a555d81fcf084195c87a *data/Kinship82_Consensus.rda 9c725923f6307fd1cb5b6e327038b7d3 *data/Phonemes.rda 2a6241c5a81a77397582d55686ebd255 *inst/CITATION 4ce2ff29ebfc819444d6c7eb2f09ff6b *inst/doc/clue.R ec5243c6beee816b6e93e5cbda9f722a *inst/doc/clue.Rnw 649a490c878b8f1b2d566cb2928f222e *inst/doc/clue.pdf fc5c32ebcb85203fa533853fb18d18d3 *inst/po/en@quot/LC_MESSAGES/R-clue.mo 6b382525256a1a059e58ce576eff7106 *man/CKME.Rd 0d61696816866774419c7fda98f05d5f *man/Cassini.Rd b18fd96f640a1001be51feae0fe8e66d *man/GVME.Rd 1b6144d910daf97b691b547c3bcf2d51 *man/GVME_Consensus.Rd 1804157e1bd38aff59e84c3ab8efc9ef *man/Kinship82.Rd 0b423e42f1f2cfba9b9d52e163c0abf8 *man/Kinship82_Consensus.Rd eef7c118f9ea4c1434bb1f4e00b77e1e *man/Phonemes.Rd 50375af82b3d133984605c006831a07d *man/addtree.Rd f55d433cb1f20ffa39a7f0dbc9e75c02 *man/cl_agreement.Rd 6b582254f38651979fa27fcd15297bd0 *man/cl_bag.Rd 5dca26838651ac5caca862e459b4920f *man/cl_boot.Rd d4081e72f3447131afc6a61d0af7f3d2 *man/cl_classes.Rd 5a5d699003782b013559e0081598ac1d *man/cl_consensus.Rd 6e672adfe90c3da3a6ed084d610e1aeb *man/cl_dissimilarity.Rd 872ecad639c4ade222bba29873cb5465 *man/cl_ensemble.Rd 4cabe55c90e4c148ee3bc274d970ebf0 *man/cl_fuzziness.Rd af83eebbfd3d600999346facaa4308d5 *man/cl_margin.Rd d4a61b7498b939cd372cf4b181378e11 *man/cl_medoid.Rd e26070e22290e167ec900cdeea0567ac *man/cl_membership.Rd 2ddf43cfa7b4809e1b211e2f89080d5c *man/cl_object_names.Rd 818d072c048b86741b39db9967dae2b2 *man/cl_pam.Rd d9486d40bc389102f8d0b5dbf4830b0c *man/cl_pclust.Rd 1eb04a9edb42f0c3ad50321b36475d6a *man/cl_predict.Rd 9e88e1119f27cc732e7b865471521f1f *man/cl_prototypes.Rd 931b58a667da8aab28dc441fd0c630f7 *man/cl_tabulate.Rd a79724c42916ad2db16343e6539e53b4 *man/cl_ultrametric.Rd 0c0e58d6062025f81c6c34ecf026a3e4 *man/cl_validity.Rd ffe8dcd2639eb402c485d2ae30ff7b55 *man/fit_ultrametric_target.Rd 3cbae2b63263993d541d67892e307696 *man/hierarchy.Rd 7175d60e57286b9735d26ff996592517 *man/kmedoids.Rd d1b212bcbf61720cc380d2aeb01c95e3 *man/l1_fit_ultrametric.Rd 9e257bcb7df23ccbca37778f11f52901 *man/lattice.Rd c393ed09b16d0d60bab37dedd95731a2 *man/ls_fit_addtree.Rd 9b0469edf996e2e47e8d3bb00dbb5ea4 *man/ls_fit_sum_of_ultrametrics.Rd 4de00e99c87ae942624b33a73fc10bbd *man/ls_fit_ultrametric.Rd 115623ffe35fcef24928738206942374 *man/n_of_classes.Rd e4822d78d50337d163d881298c234bb1 *man/n_of_objects.Rd da27a64e2cd173b00f81361e10bcab81 *man/partition.Rd 1bc099d43549aa2805afe8e5c5912696 *man/pclust.Rd f04df765bd23d594bd0ce49e892a2c3e *man/solve_LSAP.Rd f9e7119e8be0492354b6605b81fb5ff1 *man/sumt.Rd 6985140eb3d61464356b3a4ad86ec71c *po/R-clue.pot c1cb790e0fd0e4d3f38106f10318b585 *src/assignment.c 914912fa18b8403e505ac5d8e1f4ee29 *src/assignment.h e2f17003f4c681661ea31175a99503cf *src/clue.c 8cab4a18877c997d1af59596d2b40f4b *src/clue.h 1d83eaf5af08f3fc312d6dd0363e5c49 *src/init.c 76301856024f2491f73fee44641b5c86 *src/lsap.c 1db06fea8e5ba8856f5def041c22bf54 *src/trees.c ec5243c6beee816b6e93e5cbda9f722a *vignettes/clue.Rnw 6427acd6ca3c47f638f9779f323ce40c *vignettes/cluster.bib clue/inst/0000755000175100001440000000000014503542730012200 5ustar hornikusersclue/inst/doc/0000755000175100001440000000000014503542730012745 5ustar hornikusersclue/inst/doc/clue.pdf0000644000175100001440000146331614503542731014407 0ustar hornikusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 5014 /Filter /FlateDecode /N 92 /First 772 >> stream x\is |])}6ص|H-$%)ۛ_g/I$j7) 4gT%*]9_J9Y*U*Q*P*FlTTRTZYIpR8qd*t@J{2`Fh+%*+j< ( \# n+-ڮ*>_yc}BbW -AAp@ ׺ FM*x BVQfeXEmde@-h(/A8A$J-  g AT,APFSjY; eY+(@6:d$:!TF?fGs$}0 SѬa: [454̀L ;@v.v@v!c ^ 81-8 4 y@ty@V\$r@x) P2* f_F 632 V As N `0ԇx)V:_ 0K`1ᇊ~oګpATu6= !_(~ZW1gӣѸwWuo: {Ӻ7`h !{^oQuq}?տ' h*pǣ~ xO_&I<8yL٧u@Lk:*< $L/"71faPt^䦽д(1ykkK۔voT |}6?NyzީWf"68D|!WM`T(7R,eoޖ}/)XG) 7ޣwI!¤]Fݭ'qiOFtEQcQƒ20ɴʨ=hgrv=㯙wy'jxv|Lȿ$%R əY80QW =9G{ϻXp*LgaQyu-]سʼPif'J77{Ouɣd3*a?V`p8H7&YKʩwԇTiz: T GI@:mЫ~ 8tF{2өGT̩-LOՃ#4ah8 M=͟}^C~!Ѱc>S>6g$[`V qpBQb]~ kx0z;WsXAb`2䦹i}3IlL4_$evz{\ 6?e~R?ek'=V-su2WT5iddnhrF@Y N"9_6x2tm뼘l1>;H0)0ʿwyV4)]w q9.eF[f"˽W^y; ueA D. B|n@/c,xP)?˵T:yL'pn'oމQE&㚦{Tֆji{a3L)(β~R: jjMx=̻  x MtKICd &NSi>"~;MOǩC}R|>I*oR 29+ 1a|4l"w=%hU*>׍&mN7.Ku#Y@7.7/m?G:*_6sbDwEpŗ9w0.kߗw4\GU%XR.ܘ%g|Gh_K䓐z60,o E`QVE= Gt6 W=X2A$Ki?0b0¿XД%*/AytJ恴فӰٗ(y $/l28g&+׮(Lˈ4M2Q%Pb'c tM򙘐 * %'2VPhnLaɩu}n!Dlj9b˘|-sbb-ds5ɤ!MOHĕ,Ě\^i/œTjgii.UAɒrE޴]ah=c.|{ o|װ?υqهZr EqJaƝ+sT{^E{I p~k/5e} '^#נ2.zsj4]~\tMؔ*gL # d0l|Okee%5 1\.+:#Re~_]v2%hj++kidcެSew;AA29#49i#T69n96֟9T=kHf$y LI VF( vbص31 Tr)7B"E; (q!)| @.Jt-r&Ň.bbvs [9zVL"TMAkUSiPRʻ*ƚ>j Z%ScɭÛ'SXDnĻl]ˈgtN[qs슄ȴ$7Qi=AZwSaށ0|ւh2ؔ^uƒi‰yg\[7WMX6 $dp ^7HcP\TkHU 4 9BX0 Yu7[_%-p5 IoƢW^ֈ5GuRZfbt[U%uifȨ̐]wq/ڂEX\։ME_6r^n3阦,<'-kZ)wItMG򶨐8{`\&&lOA[s)DJi+R7{NS4U9M1o U.} wu+K%IKEd&bX8/Ki*[*ZYۂf],:W/ޭy翤҂]s,%ce$^]%UE`hUI^ a9qjn^DCvD 1{<_J(l}u&s9/a|jY*%N[3 HW2jG7U8OԽt7G6r) 'Bh뷄pOO+p%0Ŝ.ߠVÃ7'P*ːIiVaj֖*%Z'3a4wƘj@GXxD2UQX) iAYsиw ՙF%TrT[O/+%(FKK- h֓|WPUk̺@D]FJ)񐱢mS: ^aTfBoһhB aJua|O+hD6079aZZD5ui/TK^בd^M.߾}cpP5aģ`'X$H.`uۮjA+2)X*?4 -AnZ]"T*;Zkdz2yr~BL\>R㕂0+ mACa6HQ%h:݅ #-V=Pp,& Jo8n[q^bvGSn3PDؙ =$ N"TײI&;!+"9mXth*t$wLW! N 4}*aZyv_z9'Wu47\$tÜ)% ӘiIHG{)E9ρ!ACH ʔEfm.>Ԇbdۈim›jϬw:<;!LZ; [QQ);/ms!9LxD*\Va<\V%J Q֕&ei% !OTejJvi }kׄ94u,n[/_S\$ %s=c حg6AAkyFaZT}IxT]l^ ~TѨi qYمU:X 10 z+m$? P::>;5LѱP#vЅ .,}EOvz'$5ǀTnx۳4cϣ>`*hEcLF`@ ,PdJʥz]90P%M>G0@xci0bn\R=88^5WA*(Bj1,?86Hϧ[Bb!!=8Suy@M WbF, endstream endobj 94 0 obj << /Subtype /XML /Type /Metadata /Length 1388 >> stream GPL Ghostscript 10.01.2 2023-09-23T13:02:48+02:00 2023-09-23T13:02:48+02:00 LaTeX with hyperref endstream endobj 95 0 obj << /Type /ObjStm /Length 4266 /Filter /FlateDecode /N 92 /First 864 >> stream x\Ysǵ~ϯǤR}M妊)%mɷ#0` !HX.9{Y4gTp,EfMd) SVEhfN J#i61ĉg:-%3ZѣȌ^b&9|$:eu(l4hPfS2zW9eϜ ;\ J%S%&w-k|H]Eڲ@)X}iςŋJ\w" E$zdQ:cCQFh<1Eˢ'bg1}Qd_?qFwtm-񔾴dѳ%]aq(p/;h*h5g#)F2?E⃧oZq<`‡%ne5J=,V􆍘sE3$1Tƨ$j#gQLYc%$zC#T8M ̑zt!A*һ2:>C04H.bh#xw&|7\ h/LMj-{⤺'_=h#x{:UV!ΪnzQdNML?n+je\SR!3rlrQKYu9rїc`z4b-÷e ߖ2|[ĭ>r,ʬҞ+Ҟ+x4 f, n_Tëk\z0v,T ĹC17b,&b2ĭɥD|;x>\`:j ~|8 zXt?utv׷CJ&^jT]q2͆㫟kfx;n~̺#¦d2pI+9̪XÿKUHMp: m"&ՠy vL;gR Jr¦74&f,vbT@y8Pǿ +`/`>G+q"gA F5/&77q).|_ jZ U|Gl ,1@fZ܉˪h"DEnW|;k7m[ .Nz;?@Yo?ƒ}m߆ڸ+Rl#\(gD#nB |\W@gjAj͛%"okv TP.[sm/ gN_?{R ,e\ }`t?SךPa7iMid>/99r:!9lCls:k9?t:8k͆oφ똌VFpE޴^햹VmM]o׫]- [fKm9#N(f2$MRe J0+榺8g7\|9g1ڥ`$/*b+ 9|V7q;7\xe_5~:;ch:b*([A~h퇖H4,DK?H@H6Ebxv+ 8RR|>H \_鯿t[v&`:|<h<LqA^-^pm6^y곛HCpHn^miۃ&ۉFs m}l{_֝߇fo`N0Tܧul\ew&&drpoW!/W W# <@f\/Uv:VVݗsu&]e}2{G+`L/iIK/yp("8H3qhwdQ >Zs)iURLO 9\P::hꬲPj% @%V7&_}ug8ҊB2͹c%*΢aiݢ9yͣ\Q_P(7B+M2C},I>]|$tI44SgJ{no-) )h\Z'Gj049<vs hBGK@i:uW]~(a?^H7<`{xM!mH&-?0]U( %xioK/ѦX /p"/ꋰ"k(^(^X))ڰ˺&G-xLN`P9%8 ҫ3sgQgn l>2 vmc`$6pZ5I8r((Bg%aQ1o.|kj9B] `Qn|fQ7n><{R* EsV%{ϼF:Py=|- \ȝk}Z]7)l-̕:-QPC]Pè;(E5?b(_(0vX^~~y]`ja`<.oDaf#ܻ9ӽ4K8~<{R4b2{LF:`=8%Clau;ۛ:VBE(-oę亖#fҚZEbSbQHmcncf~S5?;3;;gV"+o"nKz]|ɕ/3t]P..QI: uHKDm6v("K(^ˣ2^";2)v"MqA^utIВ` h6'mbyi$I^ K =R zz0X\W|zpP!D~Y :oAZu[2@( yš\SJGM. r5u:i:,wau$D[6^t8 nmQ0۲RrzZ_=FҒ /_dE "΄Шx)iKůbv9ZJ6P FzNiQX;  Sk{y5?e):=`;{<2w/BCÎG~:d'jvmd{/u[ݟhswYb!mRaT\6<)*73zh+n٢e&/p}/P,,eu}=lˮendstream endobj 188 0 obj << /Type /ObjStm /Length 3095 /Filter /FlateDecode /N 92 /First 852 >> stream x[mo7~PKro@Q qk͡pzmz?Ε|rH=JY ];|8rl(g\"Ndq%Ǖ%?䛠lJT6FIKgr㏱ʱI>ܐryܰr)x䭠a"VRmr(J"pcbCxݒbQ9ˊ]^1K_6(dqlR/h9|UD.<-Gh9vX{A1UI*.C&B"YG Cq91@%bL&YD (/*-UH٪TU6r*Aeoq$GiTNC-g؁L5;97q@n I]pnbx1`1e amwa#DbmE} I ֊幀>0n@ДC#wå(FP;hI [}'wۭۡo~zíftm>3Mk׈d|ۜ4?5j&Ysޜ//'}s\,ɪ]4^}hgʹl.岙5檹l߯ot~\]~\6mͲY5v^pdځ|퀍}\N^..[mLKX1a5lZj wmRW-<Ȳ;-㒵Q7ݯ7I:25xy)DYmg 0| “bf2gnzexaәy \)zp 3/QS7AdtH}C8gdFY с`,/6)mŠ ݓ4YqL0BfG`!Y :ϋZ[.ztjrY#fZK ;/ ᅤS*/<6l8%$zBr<*H>ޥox*]Q[w 艰ca{,s_ppl{/2xCOwZZ\QJE `P))i'bt &5Fs!P;G){ vdZ' opnXdq(c! ; O!,~}v AAC68p :xNq!G! 6 Ovg@܂K6f!\N:{ft:pOg!:܏oenc^s~&!=mrЮ]={{RRR˦*<*<*<*WyUP?]RȒIɌm猆O:aɄFCEų Mۧ :l@rutv.;r\tF'ef\Z'{td"z> mˤ8m,Xl όl ޠCp9<:A#ux@0L%"Ea]s;`JIY]I %Ƽ^TyL 6`6;:ZđS5,>fp iNeRpC+BrwٌCF,'w8씲d ϝoǶ;kvZVx~4%;(dDbY)7ptd݇5:K!f9#rlpl1SXkpR<AVJgiKmRӒVt >H|k]va񓡻#Ad褖CNo^:G6cpon,*vʨ5Sk:LuX3ձfc|Ǯkc2ױҭ_y*_ o>_GV oxKYSXc^1[Zu{{lP˯j 5_+6wCĜ^/s)>mVOKyuW=mGʧ?3'ޜC8Ga^!Yj5mwkmg햢M=VuM=o9T55SؐnW#c9qH:"~4nj=]O QN\ 8X@~ta#/ݭS'䗠L bԽXYh2պT*Reu9\jl=+[U^rW+.w:y`Å Vc.L+PҤ(I1 S0o߷PB+Nֺ%u5endstream endobj 281 0 obj << /Type /ObjStm /Length 3124 /Filter /FlateDecode /N 92 /First 852 >> stream x[r[}WౝNpd28q68R-N(R!w-RI٢II`a}Vha<D.GS3 ;daL/Eеha.habDbL`ָa Da}`|gaSgpZ3;mѢNd=@t^{tQx[_M»׳s>&df4S+%D`/ "Dř(BJ|+P;gua" E"X+b zƜNj@(>Q$8D p)SDʘ9-RICge9'v`UNXvN]zL~;|(p _I*AIdr2FBag? %<$ĸ~"bhD1&Bb2 "psXC$3,-a#9\RAtc1DލE@[eltR aUW9{@FS B [B=櫥_eg3glԞ=KiO۞mA&`7ء !42e9CWѪ'W]ah+ me,Ee%0+J>/.EC`*nɁL:?r2Gΐ R6Nk!1_q8BEdB"{~bU|;<d2 .K(qL"PIA&"=Zsbt8d B y@{PmIvAKOY?tk9'5k**G{PVY?}!3Χc%-UvZNN&Y2S8Z Į=ZAjh58(ƂJKRz8hiyk ڟ6i{#(5BNҢ<1B4Lփy+b%MӢZKFf@g oJ1ÿ4lf/Zzz8e95:`IYP:3Dfl~' fCƆ:LCNhm:QyF\3]-NG6C7 Bg6]7#-ٵEfкxgx׈лf&ѽ~Xvb,^Njy?كXo# ][#iw8[V"_ 6{AJ,t -d-8c/^f=#І@@``%(ۼ$i׉|挦dd&d~jpуngGǁ=~u5((:29tF5 \`]@V[BrX``@ڼqCwjxqσސJPwк dThmNҗڠ> rY69`3=ne`(rb=58 mAqpp[P8A2bi*؃ut^ӀtT$G5zw ]A2pbQ[=18mtg]Lai"nhm{ {t6{$jmN4d0P[\{Ga=bk:إp ?@]:vF as%k֖:Fh-?ˈ}q t[v'NVI`?-: [{A[)C=.Kڕ :p1Uq˱:B9 ^NMNrg#,B$[SÃXb /gl|xT twnZF_mu1-t M  x4I:"}ivm &cz›6HT{|*"!wg}5V3OdIZ֣"5%Y2UK堦> < 5pքG=]D{0>̓h( nʓ"]Mèj2l<^:z ٳ?p'?pߓ٣rd\=-~ԵfұV[\b2PӛEr3_u/jj9-/J.]VՍA,E~Uw[VuK' 'ѫ%^?Ӡ`#ןYJZ>~2vb]۲mY٫ir=S% 7WO[Q뼷V .C8vc~wMXТQox9mͬ9M`)؝UJ V[m[ >l֒<4L}87SgaO"zր4lt}=:Vࠕ@b^Rwz<d tbF *-ai>t=nt:>4(kᝡ }^'xATCZ (o1ÔA|[C"=M1ZCR|dy [i/V[Sl5N8%E.a7W6rZC!NFpތ-VSۈg(Ǐߍ9x`D3->屽39B#ytbmy]̙JR{G:輘or{)3CFk6mM; XvVӀKOV9Hݦܵ[3Cyx{)wWj3DrM\E^ehe͏C0aK3[@OcXY6 $+MŜx_JCvlGVL/;<j2Yv ]1іendstream endobj 374 0 obj << /Type /ObjStm /Length 3468 /Filter /FlateDecode /N 91 /First 847 >> stream x[ko7XcQӦNڴ)#c4s94]wc(Ùs ci\=s X ?4Z;44+4 d0`4ht/2e5Ɖ),itXJs_SXx1z3ҷ3V8R ȰR㱐A Ŭ3 ͜T# #,s6P\EO}^(3R0o,FxG#Kżf>*teAXHxgZXDp6 qdQF)b<:+͢qѣe z,zIFq"B4Z0) KhZ  MC[J 9fJ5uh06H#Zڡ҂_$tqzlՇw\܏1wb_}e#l t ؠ[%fP+DZBCW3%CZzDm%ʷ$VTB;U PR1ˆ0V5bX֫05!@ CPhyb[&Y=f$w'2Ahtj%U낶 %{$Cr,sItŢ1,YDXmo{EVJBI T5d=e䵈zVT;dYCkQ 9,xP Trr]V0L $s=z; Io;k6wG~UK{Yo^/y(bk{DHL\SHBבDu$qّ,;AҲO!x$5!|$W"[e:NwGY],P}mft]ALjwy"P23CMyoxr6/ŏ>{@Xh:\`ś}ޓCf1&NR:V}HB5xqAb8R llq?gJWZTRKUPI=P3M+n^F#`ǓgE} H/OoEYUq]LY1/_$QIه9dKkF'{@ÿ=\3dzU9 g|I%2-Q!ZW?U?g(*ɿ>9fH9bO9ʡK}_)CV]O^?IHMiflC.Q#TFϊEzQ\|(I[GG'E}ZiW!U =!XQ-Z=QoT-~jjӗ1"Z~V;!e2YOuS@g䲟9,{B*rUjU=Ql=U-z]Eo_TmE|\k$NI\JDL9L 5)}Wt?o)J-)ũ0=ߊٓ6hޠ'gk[H'i:khzuuVSP\tXor6Neyhnf%冃X^|*>,{&.k#[ Z'+WxݨVvE?4>v UjlB_Ln ^ф~Y啬sCɬ ǼvU딦q9 O λB,ksx@ :"GQRS= υ!kslDѼ65d\Tdm4 Ci9d%@#YRWQlFgT7P8ZK E:'!Lzt3DlxhI;i[t1Gmƾ9QRGx) [VgQ!)J' M,t^[mb*w<.;pZ(o!S^GZqU mR NiGZpH0/ O'ۼ u_Cok]/htS_Uk-y* wQKTl [Vpi!#V#ds-<#xȘOuʆ*['&6@ârs :hq(g6gv(wd|Z|jq(OkMpWjM?i48!eybp@kvp봔 0Q\<N3Ŝ(R߭NOZ|2Hg/J"xJ7蔀&qrϯXwMb2bgQgfyto'#^o?WrEr)Ŷ@ F@Q) i;::~#e~qN#KSVn_Rݺ:H{K^*ܐYݰD@At{x-^!.Uli,NRendstream endobj 466 0 obj << /Filter /FlateDecode /Length 3226 >> stream x}YKsd1)̈́x8k'Tk%+;C|H@rV[)D@Fb/7ou՗ͷw7}F{%=>4'^rswM|i!oz_NNe@LxҸGa-BJ),.! y$4I Upf{;J7~#BN۽|0}Ui]mI0})%<1lQ샗"1 ^NT}Luw>zl6(揙RM{hTCwG#Ʉ4g-3JQ ;! @&׬ACٴx;ԳR=iħ8*]6J#X-).AaW\_*8CiDOJ(_~}Aѳ%ْ /sSWd=бlww}@ۀ;aka#c\CZW*E3~!zd,&uv')', Mވqj[]]iXOb#c #` N]{IE5q#9QP`2='UzӁI9Ք,K3H C5@T " XB;ARN8h$HR~ѢRJP]b+nt #j@+k {m>;sIRA54=B}Dl%go(k\Gk(L8oo9IY81W(͈߁u p9~jLHftud6剱 z~ >Ȃp@Mp,)IΥ+ ֑uB8qvtHu>v=Ԟ lDI2 g!Yp|>6;6י 9D|*iM`K Xkd.J'޸J,tt#D")X<ّ&р|LqHf,'+'._UGKDܻX+FpՎ5VQ4Vwb$LШ똲s5Y;(V+dD+d#ɿ}w7wѤ:UHNS@)" .G7U4]`̛<ҌKak{ 9"gBA&63I n)75c\zۇK64pv9xsz2UxcݐZt: k3Uh|>U4^n[&w;W73`JJ{HjTw5X5ڢ_; !KV-)Qry%"F(t<݋*N^@+'`Bw](WK7<( ⸀}ACCp#rjjA%RzFSq+ ,8\s4&ㄚeWב&ux\FGn 8iNV$$XkmZ4r12@ľy",2Z38SWt4Ԅ6 @VTi G{ױsn _^~rL4<4{ ZyXP Q))nѫ!Y{tuАtvF#8/m s:BhLJ-qrQ=e*i GPߥY#s"T<Йq9t7X]dJWFd@b]Hɭې> stream xZKoHri/9˘o&6`^`[ŀ*Q)V%VBdd<"ԕ/7O~}'MyoMS]!oi*/ՍR$}֮ji˱mƵ)C~(o+`q{v?ⷿ\:j &M~_F)L+Uv*H])cBՕ]e1/]0lGJYc9v?݌6m\%]3nrR;TdHel/G~9tݹ$W0m9?OSCɋKT>ZmYq.lk)5|~"/߾dڤ`.@-C)$nܭ-l<\fI~d_sg[W!aoMKU hЈ(rl' 5% %޷8{" s+"T{>vfZjMI$bM#>@*I$0fhQ=v驼f(Arx#Ⱗ<~0)v-@ zcWZπ$'Ax5!>0^qM졆c<%̉cGĖGVNY%LjwDn4gty vS[|6xz2x+8/'S{>`ŧt0b)0UA } Gf~ܠ,|CmJEXx2#a 3L}Ixt) O='l5lu_)VY~/$ xAAO7Q6C5$Ң0HX1$-$O󸷰Vv a ޵CO"Vb8}ŵTk hW14˩ ѿtTnR(a=fsA[@?CQ vSzvqfxűK7y~IVڷdADU81kyuAԡJ.ࡺFy=\xs}xY-x%7WߘLũg]TE5X"Ysؙ썌`LeSK T ).O * NѸ{ n%\78-uʬ+%4λ؞0,,,I$t46NGc}G0tgCҎkPCPj}3_ΓS8Dd!L8Ďm. &2n6p\t#UQ̮dܿ,E"זT Bg"KTWa/44=S8~b'^v X|J? ܍ "e?}ΡVKTEg6(!TMjf洮6 T  fª/"أ{x̋00t>ܥY(CCo,EYg mKw_H*)2H\M주^[e_@wk{*:Mԩ[/Fԍ/32^[N,M٩(n E'/siC0϶ԀOMOߗR7t 30M]25u(VvuI#ny{ܩ\02]+G*_ڈ."_"k \^D_> e֖NDkM!<.OU&pL]=Is|xkPY79lϻ~leV.̒cp d&K mK`LoLr6}+m '@cIˣR)t4ϡ2rql>;\k`E0Ժ$~Hn:mcKI4"d?$sS?ҨEF5hNS 혱Q ".7=aeXHt+c9[4J堻+:9qSN2~Js^V]咗S?|:r>9G,uA%E`b%qsj*}T> stream xmyTT00GEsHť!=$K4AaaEdaDą`P5jڊǾ!Ӟy.#,-(@`$vsF6wcK%R9-)9E.:s8.~CVS~?@Rk)jEyS)jjBTL(8g`qS._ZJ%A(O}e)Ѵ`ߏ>[;Cg~ 1%q)/ VEu/&?ge;XR "Qu&kC˽ifJ<PE=&S`"\i!֙B&{mXpլqbl{eGr!_lm,!QWNtWw$n)F'#QG%GgECD֥0X|}%qoR:dǿM˱؁9;)8KĤ57G +v%T͜%\l?ف!L L؀ ]x'릧Ёzo(:KW+wëDSex ^fg+!f&vv7w\҇ݓϪ5_R&ϓ}qzuL+li`FEagU gҟєmZ6uFTSQqc+U˧"?=Syl622@{2&lQKvkU\O%U :8#JTEPDTjR[QG 1g~rQxis-olbx 4Av9wQYIK|>fq'^sF}\d0m 0epm8*Ke4)D|ԸĎp雮w[RgZLhWa%iF%G8"E">:2ԩ롖?|/杙1 l'4[ X0מ7!Kolf/;0iCQ3wEWJaؤZ# Ď _2\bEIB}#d9u'wZZҎq؟ld^`鎆+2nS#!&&Wќ,HtS)L)EެA?i¾po}=yi*@Kl( J3 rd$ս*lڊ[7a D._7-ď̚]8BB%_J,AA] 7`FNs) OśMZBd^'na!^t7p'[^\^.IB(,.LI/"BU:Uּٌ 8Xt : *,krM gKfA?<if pKˠWI4"X 5i$_5*F'=Z$ok84S8D U2! 2iB3}]0_%\Q} e+GڊjcFOg/OgvH \kUku@-k:qɐ)Od*_[PF3/sb5NոGƩITP'Ojkj'9g]dwqvfC@ےLh6Ye4>ȓfyW}ŒAOnH 16eVGb3F(bn~Gfځy8d>HZ?ךO'p[o 22#BXas^HK]~ǯ{;C?V鰟vwl7)|Դ j?-:z$dg$N#(Wk>VL䥲I{ :2Q0?bd$֟i TMw~GPA.jrEzm%*PFBrI2$htxأ0KcG Xޙݟڲ?VoApEendstream endobj 469 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4719 >> stream xype2$@8 װ$! 8sbǗ,[e:ò$[>s@\E$`vZmjOIvY_RI~{KDwMܳr3/3C~0.fsg}f?nS֮\ѩRkku5ZC]Ɲk[Z*="Z-Z#zTVT)Z'Z/ zRQHIhhJDT.Z*z]L\MQhGň$%ϖ|8J]'^y VgŽ3z5~P7cٌ ?t8Yf=JGD3LdL=)r㿓ن+`xvSnpasxό9$dmr4oVIeWtb%9e8|ϼe^nG{y2®v@;Vm7 BIX2лvxWrVtX,GgN%ϖ`?cWV.oԎ俿S;?TTL/'O<"~? t e2O=`k.}I#"" `l|b0XoE@:W-nP?Eڛ%2*x[S^A 3?/rШTvizx?tntn.Mux`=Pk1y NSiSsiXD/9Cb.s,AOPb?KHƻgcɼJzQߩSE}@xÁ/Mʭuc_`5,j4Wh,x/AD=S8VƅraPN9v)jCrQ89@k>=~:YO nNCKk'^$=Ѓq׾==V<= {&57 3E|ܦ~YAί⋖ԭޱ)Z7)oԖmFܩqj( l2yG?co 8}Nh.as\J@O<ÐCq)A", I@ohh4[e,X3t6+xᵙNbm&MSgKfu7;$O.~iB*-;F{~y`jw>+R ~1}e񮈩TI|o\~]\ 0 gCW3@XhBM~]ߜ2ңdڏZj_>O'?Cp`o/Z-ƲQ+pL7H,OQFMHӫ̱X0Dz ܜ=<좼 )V$׼`Q6ڜkxݯH><5'mWx1_Ŏ&O ,mVu;i 1kNvTj^ihlc0$n~)tNh4;wm$w5~f ı.DFXz&h`ռWBрQQx? ~1%f6XUV?/#9bðד(rLiv`ʼ;N x+v+E뼠W9Hx$)GܥAë+""ÿy?y  ]r8/z:ɰn|5K[=yHlOOI~}lsa#.sU2Wlx_k“bFoM'AzM\EoeQ|PL!KhRnu׶!r9[8L'`5F6eXüZ $o?`3ۢn6%ap7!T.-kCؗOjaV U] lS,;&3p-ڲAѢYLWP1H)e,e ZJXwt¨ Laϱv"4)ȅDkN2xtmk< `N<& aOFa(qxd,PT?r[I šzB} ճ7BW<5*^W l6h<-WG7B#Hhō[˫аX{04@'<7ؕ kִ7uME"oAz^foimۈ\+x3<T6]E7 MЈզk[;_w,Md;΅#=G".؃M+k|LiѪLL?.2u=gJ!p݀?g~.ߤaaL~s`EJV> 'Q7n|oKHn2K2 y@u˒$3಴V$.sdcƣJ"Hx3zICAӿ͉ܶa͑PɆҐYGy}P/GQS?Aw 52PEYPN[S΅h~Wh/ _Z6+[=DѴ EG<e)F!l e(BXbw")zʀPC-}&۰SGWe3E!WdJjXi'ݡP ؁o#ʓ_\(ɓ1fX厾y7Rg!?W5vlP7^Ke'_ (plrJ͛6s+`I:aR}_0q.CU+UVTuE(dzz`> stream xztT !sEs3AA J;$LLf&e2[&=IBBФ#HjDP|~IWKֿ~&+,D={QQQ\ѣ N@ֿ:41o45xdk,<|ߑg2gphV[ْ9Mss6MK`­-N^4u`yڊG<1◣6~/cƎ˯<ꄉl1X@L "O׈abb ,xXF '+4bN$V35ě(b&1EDE!fc98b.1GLWDNQe~M~*ϭ}żǸZ~ xPǞx`=ν 7_kL zZՑ3hp۞!0p.ywg3q4drQ@粯r2M A)>{u`>I3KR:Q-oArio5ڌ A1~syy0O IndfrQC.dk;?D\,%V'U':h}C]8\юbWZާqSr`3?jVԔ+[- #n rE2)*Ȕ R)Kk@b'_MN ',*  [ʹml-j'0dR.Y%-I\9g?|bLd$w/"5D[*5 zYoL}uY- ‘9x'Ry.m\D:/A { za|=$ `̍}^V118wT.ei` &?(2҇;FA^_Դ|R4M@kR8WAO339D<fٍk,>w]W/n~DؔJ@Y^H٣5]=@dx(eXt+mrΈ%"fl"NXԪǥm`}k9"O?-qh5lAQƧ" N"ߌ@xQ =Й96LX $C1~?°Q"qLc;>Ҷ]Pe)QHҙBFoRrJ\iŠ!PHr[Qۑn3OB}Nr='Y|K#~HzH2FӁP9ٹN&"Yv>Ϲ .?:*_ܬaaԯ7k DGYP|i9Y22# sV)1ɅsWlQPQOȁ3A'x>|Tn9EG&*FY Z7\1=G]°1߁Cэ5[VpedϢ 6Ռ=Α KnrAĒ *˄8e 597Tia_Ip .Op,wB (\epu{ ]w^ׇ9 P`V*5Ӂ}yۀNINk]_eB;[._LŘfRaᾮؗyZ,y<@Jc&vӋĖ k+Tkrqz z9MVl/apƴ#qG}k?5"T[Jil07(z;{ lŐM$ `F K__yvm=8Nˠ1Eo3:̔SJZ m5Jm̄{_stv)_: kw}1sڢynÌ 䫄8l3G ;~3Wjm:j ,ye+w#_-I~@9mN7ivںf6%@h0gH^8iԸc76)5q?ݸ|8=kPS6ˋëc(@ћh##]h| c]ڳa/ea q߇#y3ch1ɽ~8 ŚRH؟P=ôI @>A5eb4 ¡$w dLgp{}':N&7eZw3 FedBa+?Ƹ6go>&rwiT0T;tc5H\O]SL9W%֐ "(KxB*B-.k+aLIe|;SpmԤ .I/z*:U '惛~ZD[qxdFVMS]aQYVqhFhfWvm(o,;R~∣Yd+l+p8 &VT,[aWE J6cUgn|`[KUgoF8 ^>':+>othlrA <2UPYW5X.OWTkT56Y[!i` S-0bw}w-̀=#B=EX D8FC|#=sMC8Rƚ-ѱ&\If7 R54|l$?##xI̩- K3i!5K(gtc߶acQڣ/݉Q*cQlezKKJJ }E>XX&*;olʣ)3͡ s@\LQ g>fº V^:?We mNY&+77_dJ;zqBn9E; =q@KRZZE/Q?ְrM10)b 9b_zcޏz4.%PZJJWϊ2 u* m>PKLlU{ *^dUȠ2sjKT]{9G_Οk\Xf ޡZZY<NܽrRnN hU >dŐH/@S&/t^X g,C╺.hU4׮tۧV{*\>\t.tKeRuɴ3LFU()9*ɱtepQGp]h<@]`~NhHKQ^J\F/ bH;K?UI 5s@]PJy46 /ChxJ ư1-+ao!ސxhg#3ၞG lHn=IK* \Uzr<9:9&@WkUYb+_!lmF&vJQ1ʘ䛋jq[7Q%~_ Y/RH\&.yᔣ Y. Ng3\k̯LSQaO(]{0.EQϨC>K`T5lvpbFF nXl5 ;׾i[)!x,:wOXDȎ179F(0BoHmp% gya.uXf Q^) qD794v ≓mQ4.9a Ƒv\8-2t^ r`uyEsfqQfRV_`wpx) "s4 }ɃaԔʭum0ݖ$qZEꕿ,|Ц*'Ah Gi4~}xfrzz Nm έۻbIhNM(i񻪽o,Rtr,?zVSc!k*˚lfNr*_PRZXTR#dlK.gF`0c[oUeMzyZEc7?tzA. mQʤ!<7yd_(!)ӆgby~Nݬ89KXȣe1 Hp8 r$G+{tcW`ISiYVF.>>: S#pJE+@4AqSnoQ0Q&`oRoY469=2 ٟ ]y;$8bGƫo4\Dd rZsbokl>o%LBW?.?^zcW}$c=IQ&jžZvz\^ YAtAg:JGS& r- Z5Ke)*[a%%"o?{Q@85 r,.TGgqX[WA8 cӶpm] t~Tڹ  u!2ٜ4}s;ke<̗L Rj(\AQ2Jy *ۅY۷v >P۷޳# ʂib&-+=+MHED ZGKl'B$Ds!TP&yk䞓 K>#|EG/HieyA/9,IwneхB ]doe:IXw"@\$/Ts'ӇsаSh ߡpq_.Kpn* 2&Ҭ1hLZy2_T(Kz mykU0n%[ &tTu]:z꓿Gnxv~Yu4R[L)p2m(!AQԔոѓIrsIKm!ʑM{2tg0Uy>Ϩ Ƨj* AC-BkEea![53ަw?Lf3,h]{-Vu4QXȲv'ke* &,3f&BE AK:p4*fʳk*KBVI^^KӶ* GxX{Tq/Y<ޢ~V kLF)C(]`?W~rͽ&NKΩ).q=oS[0sJ k#Ϛk9 GQ<x>qR0*q& 6 ?&BX~{=Xa{#ٕsp<< Vkj+4ZZJsCf+hTBPIp=[!<<6qLJR1e6PGc7"K"S1U:]6ƟVLEh)߬7b1Ig38igu7kp5 |oY3ĉa.1tW":t5 }㸷dp}kRheN}[~# Q _D߉yC-'}lf[.VtuULp:ZX?6n/t_[SSSzW` FN"V }%\( ѯ_:`T״hQ@Yjd[R&[Ѕ-h]f7 9>Pjo_H܌RVu!qP Te'!7C0Ƭ Cޤ+cJktgܦBKp`8"uӯqy|4g.P#Zf|]R-KnEI#БPEBe?6ރ쮊&28> p5as{ӏa_4;UWYYW]||ǙXe_sPpu!3ep~1ĝa%]7 W`=nE|xX(G-S=Rmz }ml+òʧ&? ^ /OI{0L7FKnW;~gPY@e\ \q-eW7ҡ%pTEq$)8\V**dWo 9T| <3ܱxR]}sehL#@eH*5eMfFED G?t YX0'u gvs%Dn{џuLॠ,ݻMGU *ksXJxP,t_NYḎ4YZ&0O li6Ee͔,Rȸ?d,^ ZUK6=Y2ߚ0p- CmXs5 0R:+@} 9`cS0 #wRS;N>+b7< 7Jl;nu8eVk+ozm})in{ 2!/7;n40X؛߰1AVegE:;/džaձ̽ ?Dz:^Y8`y73R7dήjBElIȨׯ.©up4|4c'͙v_eyxb aqzJW.oKEC002-%Lwҥ.u_^>N<*;}vlMdԟ77^y?+ ⮫H2(tⵡz|d|g aWp}uU}S;nHvLj-8U$?CֿKLc]^˚9 Z[Y{Y;=K>O^Ƣ@+U(pBSZfD೨;;װ2+~i/ KNha-N]`6dnA?@lzSa+zS^i 4,(Pupy4y^m0u억XDNRrFQ6j* Sy}{7j4-+zstԯnsƱ%Iw=>d Zz ;= @]^hhَ8zmR> stream xW TSW־['v:Z_u|Њ/(" ;!@ ȋCBHw@BAPZRǾlk]֩3vNk֬YkuorEBMFI$Qa[WdE(`#av̞^5oAh[~?B32rrʼ= {%lv =׋PT$EmT Pk0 j=N-6RT5KQ!<P\rrZр_q^&{4͙g&ͪgf%VQs~\e}ޠVjD#:"71܍Ct_garT)ܕ0K[l'q)Qw9an+b۔ay%CT싓F ՛a3Ln >޸ؗpTd-4@#~T.zM&gV.#@X}di8ZDG%IeIH.f:Ɠݯ;"I$J1Ϡ{*5l`&0gą6LО^*rAnrჅ FS^`ڶ =E hw YndGFuܞ 4C }!2x}=fU% aͤJ/k!ޕ#mT)Ys5Eǿ`@k֔VjP E.ct71.G:dN 8jX ZY9"rVuAEa(7 a1=ћ,(U-Dſnߎ?*}CC%3G :ζw 7Ա?Lg2Ԏ0(9(7AErN$&8ȴx\@9Fѹm,a!h%t>/`L!S&2[.KM\pOHG:<Ӣ)bS]|*Un4ۛѴH2({OXGNZƚ0`WHQbޢD]VeP-D "=WHJ uh)1ƒoы%&sSe7\k -&]EYJL%$Q륹/][};zj.%,'+SZ3e6@s|&}ٿ-bb]2`' <W03b dGi֑sՕ 'ԁ䞘 he?Y-_2sT5+ϧ?YQuQw#prml1[ʺ4*FHJ*׳zz{_ۭk,\XE=E o*h,<6ڷ?y0K:}-=g>/0*`!͕YVXix_7φ7Ȓ]Insu-@ty[rJ73P⨱YeC~{pQfQZշnNB6Ҭ&G-A`D2l]|$_Ėox#Oe4\؊6N2rBaZlaZL3)_6h\N$ [rc"@֛#"y y(- xw} .BO/eCN ]ً2]zUJX~ffZ{pI8Y߷JXmfReބ#BOn’X4e~J@DKj 1l'Md HP(7 G&)7ϔxbw7{ 4A0&A֊;*,cx|t «G~'Pg3]ur:R!ݐ eGGubo'_PUe75X6 X3] 5Zq -řbKVYUgZY'|v)bERO%^_is$G9S]^!Y RV1 ez(fHJ >;"bJ?F~mt_W\߮_UֲX(V'G"lγp(ծO?ho W8J,\o+{?u1 Np1Z.|s~7B_o o #3)Lx=bkvLʉfZw1:1lb{w8TOQyٟYV;x5"j˯=wBa -q&$&&K-iCV G"N=MAnTI*2cE2eBB>9MZ/;?I&eynCMt6R6|ah :uI𦕠0( uʬj,ʣER+bdմCBIqTޮ*r?/Z@Dm҅3̵^߽~+V2xԝu]xp[ݲk.3iM4” |vpyŠsDmA!B6P,hP SSȞ/Gq*~PIP 0K60 Y؇N<]13j}iVt=Lu:r%47 ~\(Ҷ!Cb3Гt񛞉,YlcC]o.1pߊ񣚦PP^ b-4(7y9fϠW^@endstream endobj 472 0 obj << /Filter /FlateDecode /Length 3790 >> stream xZ[s~ߨ*V\5<Mȅ<ڱWǻZd뜤xW{=rg(?g>ȏpzzT룧UlQGW ?RfGFb}O:ͥ4=s -=.;vZfJ$+E ·k?ʦY98R0z]Ǯ֍BLXIJ˶YW/,[U^5q`&,]sޔ |IXw4q.p$ipE a^fY׾} ~/~vipC1lAӜzUu WΪx"`M]ʹUcNm 04f*% q>utO}L}vӧF`;lѬs#$/ 3B˲tN7a #5(shj$ue&^UZO=q,q5E{K6amz&lN0o @`,G,јo!/eS˸(87^xߌm?m_=љpG0!?1ivsy7n^oG<7dG0Fa Es1gOljc"S0P؂J`wٽPbM,NMShBh6MQXsciCq{{fi%~KtJ b1]EwsC(xEҪ6&@V' av! ST^s:*EMɍohYp'1[l˖K@T]PMƕQ;ο]A|#eDf|S)AW !RКxXF1O+{-0xNlq |t}FDLˮb#fٛ q}T\h҇|,mA4"q.]0kP@,]/$ П+#ԙПRv=[ <D|pNo ( xH-;jDIf^!%ЪQA}xfM ɧ="X9l\`ͯM{}nkjBfݸp2O=z0fQ)"xv%yf $1t\ﰾTb "q@TC`u~Z(BO4/7mSߐ ¡5 {@4UW /!LqD>bW?nI{93-cjhEta6M|eјDnhEN\fdJ:%rq'3t"Q#.7NԬQk&bOvb=UptH@.?qg$تIS DnUCzhMD6UV`l lxp._d!#uB9[R#0܏0c5(%kRCVJy OwMbVXTbT )A4DZ$%e5~/O ׾cC7#y@ӘO4PX~An (<"̵TY L )\{є wr3mf7#|*`drbdrM,8$9?<϶R}*`T@ u&ov54-A#([zbI](O7 ށpl~Yv~GA6] _'Bֳ!>OkYma8LA= 0$Md.=hR]4aDD)0%Z- &%bɢa`7Q4${ZoVQ6BȻ 7SwX/CHJi,5V?5חI"SN=0?be`ŖW;)X$o$~EC :_ b%r@)#gzZ^_a- fqz kDwU+b&LNUm6$Z7tq bOrCB h(tIc'U".䫜?RӐ8y|yg Ǘu.mJ Q&V74F?&(R$Y(:@@E]C!4ri:FHVNՐj\kp8]FxZ7_Lv+0|_w4;x|6-L g -'CQ4#RQcA$4,ah` iVT NX/%CZM`9-)w0OLXCNZlqo;I]$&>jDg)Ix5L5)b:go'k F[a:kTԒ2_%5qMiPDE&0v˪ڤW苦 dg)V @)X>MB⑬@,[,޵hӱІ^@N^T6הvCA}(YTMC*[k %/&B W3?RfBbVj0jHYi!wh7&\!`ZaI&1ۛHܙĆveّ +NGdہ AFgLqJ&(9VjQ@v,xv_gTD Vh'IÞJϷ4_  `Kח*VȰR{bjo\zgK;ree\0Θybdd~R{X7h*=JeZIigRxEԥnC?Kь^ޤj3oxCʥF"&T:Jݨ *1Rt`8Ý&t/k2M yᒠm5bdlUȧI\XX{EInjb` W (}`pQܦ9 l1-`žh-&Y`Ti{lTh3>K7 }4PaQDWyܧ/uK~g L+m,\%#7ܝFHcp𫔾h/T! m+Q<3EiѢ_@2dJjBs:nse1)N|8sA(Bw J'( }_ QXua䡰qDOyԐ}+s`!4:=E<CP6"@OzĪs9i@~\ ZJ ꚀQxt~Ȓcit @)P-@;Y6fwK sZ|Ix?ac ]R*7)8d.pet]I@ge< $_S8ɭendstream endobj 473 0 obj << /Filter /FlateDecode /Length 3611 >> stream xZKstJ) ¼0r^?8>9@$D&.Ws=3)J0~|u9KyO;4[o8yLg8]5}ۜL5Q$WfW#Jjl󡼭p1l9#ы`տ. mHÄݽ d=u+r.+xDx/v?UqCezAS~$a+$5Q!n8tIJ6~%gʑ *UG` +վ}go0<  kt_rY6r]rH w8Id6vV2hA`|v [xɻٌkz_tj'~T5@\ s #c;BoK,%myqn-NE#1Knyqft.\G saU&,E8=B+!z$b;p'8 c/5楾gϊ_Be܍Aj]"b!cVuމ VWr˦HSWA^_\]z,0n21'۠*u]-LR~X](P*i~h ՂI13"+KT|(Ӫ(Ц" 8Hkp+bZYysx >Tx` Ll?3)G~:fF;ZK;\#E"h"[RH{8+2 P{Go{.X 6F@!ahf^!:gBĪ^!m_F#ΰOxq|BM'CC Hs8E_ z m]?_j/%7'6sǢYM\3TO&f GxF\!,4`@fObXVdFyx@C#=o2 M9cVnfGv7iGQ$`7pJ|GLO}dzQCӳ'LEˋstW<)sF#8F]]^pŻyu9ΑCʢuC]\N{7/з>HDj>Lqف%avRRP7k Dp\'}V7#WL8Y_faL{3j(3R6QC$)르cf}eQ\Jt.)\߫{ Jplp禟 +dS0{<3^gz,fhnZfvl+_3ǁG]3!Vr8*:䤾Չ4 xwT2 /J"#~61!C9S-g/O~|Yn<r+!tዕ/C0'>PQp8p\KNMnuyqDcEWdyFi={i-!HrLX;,͖Ro~^2/Q -^kK&c"bYT< #ǔy@5A_w8  =NYƲ9c>zD[Թe+=ސd>ԥ@[wD FYsй,.n_vXwׇo9,-Cz,+S7IH!or9~.S}Z _o)Uݹw\Y\Q $)^!$WUL5U"l0BOB@юrXOp ~rfGG=;!L$X3"ǡMP8L>;@n2vÆALQam*S-;Ʃ1b5a4|2BL30fr}Ym|x{ƸH/ O̗O> }h+wS$Y*&W)4 C&s`= s P|9֓E}*ho8F܈hw_?/45YMl_ *' *ӱďJXv{\SI.T${x~))rI]_Jʠ=s*H}k1  QI?$ w%]E8kp%ӱ҇0]J;H2ď6@t\{Wi2x͕‘-ṥY{{ T-j.Mn]Q8ۺ*x*[ˮ86h?tUAԇ6K>dC*>>!rS T}!oW@BO_s]y[_^!+C&ŀ" \̳L'aam(pjw`hJNM~ J߱]|F@7<'s6@ߢ0>cf,KZ&ySA2o?>*endstream endobj 474 0 obj << /Filter /FlateDecode /Length 3688 >> stream xZMsSrq2!r{%ۑJS)H$Hiߛߐs^LR> 棧38qLxg=/\89Q"Q4"_ŋh2UZFO9jUu4;0 $^1y]b[&XYQ0R`\\]WiD lj=VJ^RH4u۲HDT)Fԋޘe12xMTG+D@`h,Qat+&ʢ+,|&mrux7dzUu4&HEImE۱=S%TO%+lOm[=KYEr->OlB TGs v^vYWm;Xͮ0%hgb" M$܏lP*KUu _&oi[cGOxbnӓbA)"ZζQ.N`)$?/>218C&NGJ=pzə 3 eku]1bV9's(39ʱ"MZHO#y&!e}Q:NAR#t1r0E7yfnD@Iheq؉}b5')]VPnd-U5=gk"n0C`gD[vezCޡ7 0cWwFt!=IRSM۬,5:uy -f,uVaؗkmjA0^rCVGqmT|VM.\Z v! A#xó*֛e[S3 H+Dʲ!yKXQT~cӤE"u#0c%b]Z bdHI(EIkۤxo~swĚC 3K<W) ,S;R׭,HB 0 LnddWKyCBf s @y:t#I5+Ļ[Ć< Vhb aE!F#-pmS i| em3ti:ciU)e$\+NܒJO;_^qe3/Njy#Jz{$#X* 2v;c* VW- _lKz^ :?2p2%7*syNЌχS dLƯ#_祣$]m9e<]E?hBH_9ܡ"@,Ĕ̦bXjGǴrQu캮,w.uw b>e1my@l{ve+IuUΖsB죫WUަ}RA'{J=(QF(/)2&tR6htQ v4:ԇ+Ō"Ԙ 0d0eAht?#;`AfYGSzR)z(-)6M"vE|x?;." {8q#ׯw:u|H m ;qm_6)kw@.z{<,θ3.. %Cn؝"1_렧 A3{xp}ɞNtQSgA)?ڗMᤗht2 hc ,(~(I.X;?/pvqepga\t,W7d|Xs  "c2HH|GmmGlO} '11a|_gOS4kDY8~S;Lɞ8 IQKx,rIwC?o=|A;P@Dl%ޑ XܘDJYw|^G<<n7U9'nuR]W`K)E~@:&yRJCW*rh,,?l6"H8!?U2#ZQty^̖ ɎVIFlkw *ߊ/Ej8 >M>Je.iPH'I\i\a)Õo//Ii;Q鐒sZѺੌ&Tg|:^lJדf[cǪ8 nqD!].mXd7dr&Dg!Onj3B 3/ʕ;YV _3+y$lw7vk3{^VJ511OK99YFԋ'01 ftq~.(eO2OTP|wLNA{GG0u_#=:p`uҍPU5QNҡIut5<"ҕA̙8T?rHՆbA.4~~;kx9ӖQu&-Vaqv6m5:"ti,po@)j:\IIV=_HݕH}Wc^ɍo.]Ѻ{8ՏLWćp"̗IHd+m]"GUl}̋JY%e2UX91D-&*U`endstream endobj 475 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4345 >> stream xWtg ճDoK % 11`ȍbp/Mե.˖q.AiHBI lHHB !&YW0 g9OG3L9swy z;Ӧy/$B?۫|Kݠ)otrʢ􌥙Y1!bsVįLزz5w\4yg̜EQh*ZKQuzmjZDEP)j*D-^e j9MROPE!+j?>s|}~L~J$YM7\~=^tm_br?7^|RoP+8a4wyV $5 jc6I]gw$nqEC '{^9? B3wCd;zs~4 8=Rwx^qZqq/Vx" "e BWteU;x}8gŹ#Nί\,7|Q}pmRvI DiRf&'lxlpAM;7I+"?ApG/{02|筗Z;jr" .XJN,d:Ga^VTTTtZe}`M΍c\v x$[Vݛ:`OvYE>#G`7s6$JU5N-P//Xl["O l}=b1O"PH08gI_pK&ѝ+fp; ~"=S WB1Md[͵uʞQ#:[*R Ym=qp>*>h2Ylfs(Ά7K/JtZiȓq@5|`q܀D_jkq+B$ ea'0n772Ve yy5W ƾ8+z\4i4{XD(Mx2ǟ~Y7ť ӹSVPxX9iv9<2n7XLg\k[bj,Q$7B9F;3*ե֖jEuC+ TfixTȽ=xޣΤ1!a=.jlrkV:ST[PLɜ'g# F|{Bn|T,*&Cյ٬+AŒO*f'QoH VLض{ `;րZOd6-Q{4'Gc抪g M_xW&aZ4%Ju!7_C!@v/L %ר1 =O5g^(@K),r׎(1vPg6V {fw(&ҥB`{6q'8S 5+˓ǻGL0 ВJԪYW.AZ[i-Ա-ɩOm;~"{{yٓطMYy݋\ S{uF9epWbTY*n.Βgfs|l{x[ԁNOId dÎ6kit} 1Ů\U%B6&- j塘MH/Ys^%l)V!WU9.m=|u?JH5@AMw =LnnhщJs0+Mʡ/r#sc?F |칖ZcVvGZ؃>=Kݿ UjkُBR1_GxU/ۍ.p<~X#D7 SsX~\W>>/ژRuIn%!G!*π9` z"W؁{#T\]޲EEN>`ǯ iH5%vQGŤŦoEzd4D8Zn["TbqFMuB ϟ9bɻP'_ުLMJB˶#"akj+=Z{"kOX_~ ia"S22]/Lw9]{Zm*+DaHf]YT-F{63 {E1D1_Q'Éy zYQ&t(Y7"7K3,if۪_&cJ&8Bo+dy7! y%>)o=>-_{9}1-_ y48N[ghi:Q .ݾm egbt A³ 4D;]{z\rWux o]6Ѿ8&'R7z>P7+XY4O AY,WXGơ Ww{uL67lSBô ÷@6 2H}>,KH7 cbhjHkj|ƒ;dѭ8]$x=etZ *3A]ip錠3!Tc . ?>az^tqmҀSP}~t4t[%ƍJ\NhYC\X1q$D'8!}D_J,vpFg՘Uʕr]t~"" U2L*de Lpw)ڻ`~U)-nb ߇ cwendstream endobj 476 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7763 >> stream xy xUo@U(M Z((Av !! Iz߻N:!  A@@iȢ‎븜wYd{s|=_թ:e{YYY} g,^} ؗ5%t g{Rol ]j7۷o~=`H޹ηpWAHr2khɿ)<"oCΗ柾wȽ{w}gUN9j?aC5|#G!|+ÉcZH~MB2W~?嘮/26#K$< ,RiQW7Leq_!~4j W1F"oD߈}c:.'KAbZFk:QZ/a x.l9}dy-sc)J-N=pqO.sNL >*VO2V"񆏿RKHfDǓM!w"I%{O^8x}(VF 1,_UI~$^q rW~*-*rCԯm栖6YZ}ǒoSNNLwGFHD*y?^S  4Djiם+//2~CNUopR7eJORYGNlhIiCPZGQ֥a_@I{W`Q?@<${3\˧^pz}#s.;Y{Ct;';=:}yU@kIn0i7 fi @;\[!H88gonG"|Cjut#*G?o8'~Mu-2v) %ANWğ/&m4~订"Yz\OtAѹ#~9k??xK{@]V-\a\{.d jE#qr▀HF÷ʇcz$82l4CkIR'p0{RH`N7z`ĘՈC?IΎ ?Bz;TZHIUZ§rEF5~1W>B+]Qw[֯/G (|gOӶmJG22xӋvϞbPS Λ  wTΕxǻz]쿒9w)%R4oc(pY2buG@`,.<2h1;ERP typZmR\&30:Y W~h^@M&?ɞu2]dJ/tm[ATN,`Xt)UG2 5ܯsL8+PC(=hKDf)}e Eo'bE53.+X,{\懟3*8Zl'ROW["'(Hҥg~`mG'ό1ôc~j؛1΀}9T.\rǥh!*]ō9zk5tVmh;GŴ\z]XZ O)x,ʙ#DVeq!Т:{/L)ȯ6;c{v)'Ne)0R%upz&K¡,hF%4qmҴjW~sqX[ ޜZ`bE1<Fl`˚K+m&84Dj9/mH,X4FJBk?̅9?*D5PˋD %[P 'PwCS NTaṽr,r*jZ1bIs.eg;{WLfJUmd 'lB|1+c> ". X3h_  jj~A#^p3yZg=WҤS" W: vݾ--4#`ze?;$RxL쳤\T_)TL2{&-*_uGMT`aqќq/L`IS}IDS}I\M1{d~B%@a}Mi#/Nh+l%t{~oO]?vhZ$aFxLa-SLe]_vFox1Y5\j.fG*V4~҃D4 LU-:k=#W3W2W68A/ `fYE-gTO{^.+aP_xɏZ>`m.#cuFt[g| XZq,0l>ݓe6Ԉ+>@!"KZ( K_y%se87X^ti{\WwL(cN6 @YX!+ :AGדڤpbZ3̯N8]C.R|y|''du%Hݪ6݇li*tK*.FQʕH(I\ _J_-0m9dmIr; ڶɋ ?p`TYrMt^z,~֭b*D>M2q'J{%Ht՘q3Ik\:ΡAzI7w^R@k =mٓW?i`w(0e:'ž!HR+HW7 Qvi-Ҟ6gȈ/Ĩ̄3=p]tfI5!iubHJH~bڌMb~ji$:ŷxQȤʆ \,xHnݛ/^13|,m4h/y^|^7>qKVހقQC z|ױ4ص>㟌ʫقIM+A= KZ&1[8m[:w} >a6n_]{P].s2`N{s7=ݶVHuu d'Zj:*lsB|t:Q2kUueVE69,8r6ϐ7fN5jD1D_Pi+ԪJ*T}d~a')L@ "+840θAqnU6P{YڎgYDƢȫ%fco7r |@Ң[yrDjJY/*U ŲؾOI-tzo|5RtGaQ3ݎ9qgr3{C#XΌ!/Z׏g1ubׇqk1vI>xx xx{+=nFf*51BMOara.$qHz! B'8hJݜ\1HdzQz}OC<R]c!iqz(!fͯmJ5?naW.Lh:&*"V.]rpBx^Nww+-.yST e ;" L[I wl<r80aV$XNz[UٓuZ 38E0v<la)~ekpW<1SqefԠ|>>*rZ'¬LXqOxWc={oi&R5*0F7A'%YzlX44>ƺI8`.wtPo=輠'}gvohh;f zLSϭ+)P`%쫾Xm#8&.hJK&5Zmu2]%WFUnT5&\JU`MT@펖`Gӭ~HGGq% BGEY(2"jmś֖ ؔ -V@r̃0}!WVacY+yJDte>+웹N*nTJJ6Գ nX-.|T`Kku(͔E'ɜPbt졪|J_-Kw\S[.w8E0zZHHO;!p]4񝧆+euh{ш]qB1 <'O~xg]2qًgDCw8yn@͜pQAڛ /|'S.O2j/^&`m򬫬쫬Ƶ;f xqiXh=ǦV[mŖOYev:-fK*@l>7"0 pHA \KMH\-l|C8K8>s4D<4vvM|Nku4m:iʹ({`EV-nJOMiлsڂX*Yy  ^ Tүhbs52ƂFG>[icO+lBA]4_ZtdaS+ZQ>@i9D΢=& p14^ aw(x20wc 2s=h0w}S%|endstream endobj 477 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 9540 >> stream xz xSպ.{ofh DTDQ癖@ڦMڴI:IyeNڴMM4tb(aVQq:xTY+-x{݁>Y;Y~BC[h鳦Ot4 / ڞ~N8rt(v^wR..N[TLkd=+3WŬ]w] y6?𫧧>{ڷ;_˯xu^ C'fYb51G! #oub=1@L"6fb OL%" D$1J,$^$ӉKb) A,'^%V3k*u?9qH"`O !.oCaD8""pBL 8Hb1x_H:)=>>GC_ oVf$_#Rۨ"a Ճ:6X7dCG?l;7Y;YW~:{u?=rHZF}7Z;l{]F9&v옱]8Vg=2n&>wq[cu┉xsO̝Ɣ9#m␆:6:c SdrTast-4T>_G t 4:2kܸnynss4GP Y^fglVofaxG7f\ }/,c`6y.֯E>jw~ JQx/yTs3.w|c ʥu L6ٳwLN65qz_vMjfg$X VN_y!f1 B='}yp̱酥Rsf_mw.Э©>g__Ytܜ˰j^3gpVDt~x8E7w5,^Eb4SRGp1 UO =h1(,1Q ~L˰mr2 88H>SN+* et/s fkcfвt͆'&"y}P.X./P Fn8v"B.*cN <ɻLW毦tjs`l];o]F)LO8~mirȐ RhXcZ B6T0py|m3G[bh/ɇ鸑Xo_vy51vv|o<7p[b/wrlM ܙURwUnU[0f`,Zx;{#?YPwͺW[;%^KFAZ[XV6x"`]ؚ蛟[@iNl(Ku)]Np>ulg;V& w26`3l4DٴE,2:RiTZU&Q~Ywe^L1G V61rry̋L"605-7 vXVj6a)F(&`㒯BۙWhy6z+XI|0hR+ dk,DC&=p\r^m:q# >S `wgl܀fh#Z CK`bv4OrkF>SQIL*gLr v&~ ޥ1j|g1p%+<㇍=)ukR.?)R}.nkV.t3EE%hd" R.^^E ̥:˽wN&+FzsP5t\ ȱ6 $ވdG p0'3$SӁY:isQ$Z=6ݺ2P h ԯq9=1jB(_LƷLmt`Ej)m}wﲭZ_\V- 6Hl$Իs 1+e*Ej'TYWmNW7:!"O*\xMQ=\ji  ^-?=jOeC*cF еUU\.*}m>ubƈ݁h jZ+*4O5~cnu=6OjE:LyS]vRl/6hiʲg[S78Бjɵ094EFS޾{?uh?zGU9 ʓW WV*o6 Ww(ɶWHxIeäLGJBD)chϒH]5MGD8H0=a)|!)v;p5&2 jbX9!5%NﮊExqn?bx v?6S?i)o1FKx JP jDEiơI5(%%ŮJwEINغ5q=(@(Oyp_BE w?=#]kQ`p^on3:616 )i)l7Lz,@Q@WC8eXEhm0T7w(ݦH8/pX߰CŅ0Y}ckw% Q`')VHC!eof(m%ʠQ ƾOhH"_ɀK8<@ ˭FTCEaYnwo=7RyQ{ ǻķܻ~6ǔgaH*i.#[ӆ,KNAY 4+*,I+GL|Z-Sݎ{m5D9c*E&MY6/cn=G^| NENZXv^YeĬѨ i4K/{FŁK܎uM>%'ؙېx8:| ðFalZڦ J#=ho'1XKa6tj'\?}Opp U#OqфSh|:@jaa K K%\q . *8UҜn⏦Y'G,ҥ*Qs| mOW 0uo`' T8 Ԋ+ c3JZ35p iwk"ɱڝgpm88bY(> /]V@֭*a߶CǍCCya]*[=\r8l*! 塞]D}RGĬ )J zqBrCJT2ÿAuy{cˎ%uwИguLMLuMfQ 2ppڎCˣO)rM?23Ab|fh0WVٞPs1R0 NX4x*FC|rd03mS[2I9rF+29Jrq{czdц*}+vcAҷ^~ Q탕b8@=Llb"[x4͇ 7Ip\ ' '28[huN(@v  U NzlI*z 01#^ӦyɄn}΍2 q~ qaX 0onOߎzy dƅ P]~_8ckhhf:oNut`0ʊ4erm9?ėJ)ly*\2:(/)O.ILSEZFBTl+.Dg~zl4.Ymn_W~3GwmuZI@S/|1]@/w֥[dʵ~b| {eƠK(O@!8ܕZ?fam`=XJ>?XG<68Q`ea&NX`(e\c˜JY4.kCW\bܒ.fdHV8jVJɭH)Z~} 4zd"*' LA /\~:zR{ ZI,JbPk6=iJT鋤RȚyY3- QKu9'GsXϻeGxmDJ2 ImP5Ha޺ ށoATY,uF]MP]NәMX ݲw'^qz%9$Vn^sex?2Jj,Ք`5XG[z5XV WczB*@)u%̺)}( mAai%,,2RR w;0b9IfIZ)3$(&*-9Ym0,:qUFd#1EVS 0)~b$uf^6'.Bu:gG.^ Ŧ<:NsЈ(4\Uvqn >sfӶc_o-jlN 8܀h@ǠEVdVYU6@:B8;WH4STK30úchf # -HA ><让'0Ov4:09z2Tɛ^Ui4g3 t&9ۄlA}(>y/m#W V1\dAIA`>R{%9h"mX75yԓ*D`Y GA>RίKjD5 Zk'5!a8uY fg2E ɉzϱZ,fګnՃƑ;Y"u_FJJdiKuYP,[Sˁ:aem.W-˒)Z/cq$-SXPQUYFg'ujZ ~FL6xp <mqX]oSUWz[Vhf@/VD]|1hZ7 \8Q}|\Ys p+Z|@|z8嬩|/w7Wöi@'UfirT{yu磍a2#zXn%bj{n=σJ,nSxrjҬLE.=ybc C&&Pvv?6LÕ?bѲVoXvm^F,paT2lQ) T2Y'mgN=ycΙ s}9*5jIuFw"o Io!o܅ oϻd:۷':\2wҢnu/O{qղ\PzwןVɋJ⏅|3$wYZʹb3*Y?A?&ߜJMkuz>v<p<~cw} 6NN-ƪO8d|`v#'-z^!3Gl7G1U:?u~uH?XG~ֿ- ףr_J x?q8 `(e}l͈aU:.vXV`Ϊ11&UJ]b`;RިVԣu hz.S Yfa|J idEϬX.,+"lFH=?A`dFdr,G5Ҫ(bv.Mzv=/]c_QJ@ c= S7K?C͟1Oz|iK֊n&Sҳ%i>oYYݕ% +)h z q|(*ۈ) Аubd0DxF?hVQok00C:\U> |zWۡ_?N@1XZ}ΒbšcjR,≒qͥK}lul$l}ƣ4q h'RR;f_ wvw: [GcxA/# Dc`Ȳ{ yw:w=N\^a+k2 ,mz,ޡr(54 j=`6Z`6E{@a>-6=msg/*d_rO)1hQQFWEmy|鳪ՏC{(0^`H0C;a" Q8&duee{$n_"N|spWp- d蹃LEbQODPC\.8Zzl0'JJ?P៼ot벗ZJ}c"4-=0/XָF?nZb/_U>zZ?xZѣjjG r3KFya'V^>Ȁ|r-kV=r,wV[+dub/WGDi20F-f2iy&^Zv`MU:QxڕE29Mjk{AgM̌X̥'yO=3&d XSnS'K;>,R^)yMC9yܜ(@K%˩S܎9G1y,C| VYuc|p8D݃uo_AQU)pҸI{sv*\q_QglڛV*@ɂ? yl(YV:CbF43h-Z4V]\\5C,_C|;Au4M#4Wʳ@Z&.-\+!+%5.%z PpayVޫr(PoԶ,;AJ%$ӑQ3yƄScR'b^y"ʓ!Oz߭zڦGSӽ~lի3b1}\1Ch :e> stream xztex3;@^\;lYz4X;vbFBh-w|2w}ㄽ=us|79k\h7&0iǿ jG-\Zߝ] U"LRZSOWhͦY9%s78lE+TV-<*{IO<Ͻ8A<ɽ$ $KJ,L,<(Y"d!2Ò$HVH^<*Y)*yLJ2Mddd L$oJ̒<#-yV2G2WzI&͒-[%IKdD.)$AK$_]s"q=}ןݴћo1m/unFn~tBP3; ~s*3wmg=X2g|=҇>RGox95OHn5?zLJͮh]݋'HN&ݶ8pPѮdI#`:R2~J!bklRКv|4qiBIKjdj\a=an m:iZ} "A/ضHô;cCAՇm2}%|66eĔ>n<:92fga_!gԋY'i:O@ M]iS3649kc nwۨZpOpyլWf:}Ԓkv}oom;-f2?;=aKE[v#{^SvJ ' +(aYm9?/~C f=%%iVM3Z֡n ?Л}z *?]ƣ&[t4mr9u2489h-}I!W@G=IL\0[wg/#sڼm}h<8l$zci_VMtjPy?ٹ2n JI$B#EwPg!Te֗kf,hPV*\S>|繏B y`vv_bwsG)N ]PGw]^[*X wl5=wy:2mgm;pڮ5m;U'…IWiRW!,}c|v ]h.Y{uv|'>0q Ng7~ԊŠrJ?\YA=T:-iV6kpb]i&F7[`dI a20ZɓgOp?0 ęZ8A0['CI},\ b}~<t]-.yh <vW&N%=zMos}t8`%q6-6,6/ȍM/5 *p:F~ a)P>h.nJ6j +pp Kf˄:A=5rf#Dwdv{N #Gbߦ@, 7#׌k[cteLؼPZ3$, ґ򹼠cVqjRΨQ=[)E<$ )1,NyjF *K$2V.,il1G$ ]XHCCi(M&z1F0|M\D˛wBMػ>{k=aKVq3VA)D(ލLd/~d:ԝjwTBŔZ?r%=;<;;00x,%bSCKMA5ŨƦ1 /src\ fb"`0g G9"\,Qu>yè;c #ѳY܄kټ1Qq'Ir>ꉹA6霔zN}#"M⊴w)?E2tgRUWk^PΖo>5|HHqp6ooݳUO5154.۱|ڒY5MЀ)Վ"tC;5|2*S%1O2c=A]/I^mRg9Z MV CLtolU;4RkYmՆ9Ű2wz2mH]Ih}OK:j<:30iٓ^!dTܔ'P GO&51݋8M9hy>\a\+̐;-jԇ-]<69u6Jb2 YcoikzR|s^K+i"8_[J)m@_f-QU !uPĈb6+{8w24D8MZX T9o$&N]M]8⺱r CcVM&5]-e]O nd( sc4f;YG]F0i6K5uB -MvjaizړsbJՓގ^B!邏q&8.d\'Nfo/KVF{C!xiyF P>]5EfEzCH9joTi`Phܾw`Wz=[Rӭ/j> ]B䉴pn^[.5l rƮUgwoݚәALh9x4Xaخ* =LFmhˍW&0#iɲݰ aۘ v~oWXO7\Q~;NܵD(+G5@\Dd*$NZXE4@sׇUF,A.֓ t;n=Aҁ$;jeʖg4dn*2s+}q>N[`?vG}6/\̡%UհZƩH3QU!zUF&HdeD_7ả#wiw˶kAR1 W3[c6M06b8Coމ]X/p2njihR%“ S<.^U2=5~1hITmY8m#ktoUzqE`cmҔ+Es`> gwQqG?$)@ˏ9siD;H9u:(5q|W^B4ij'nS`¢%`M:UGw6Ƀ(Ox\;X0.qhubGR'vHZmvvJ;\¬D噾ZAcM`n &+زgَ'i6М0,kbTwY^GFڽo?J9|N6( mzj `ON}$PQʜWg:x;D};d nXʹoU:ůE;@d  0zCA, C=-?áH@ESGfK-Z܉4ɐ-]STWrD38<Գ%ax['^xב^Y,[reHK@-o^_/~:: lF02GU5ff i⥋!!֚ѼHˡ`Wz}5 +~b0}XC7έ)֝荴f_uQydo;q95-n*gۿA:aI'чOl W-`f)ZƦ@+`[p84MG.5kĝB~\TrƂ/au+FWcFT&YxSDB0ElRGX!W V TZKIzlw@T|Շ0j<GD9e%J. qeȈ}C ۰e.`qp7Q fNqD{&nv>ċ7AǀGĎB 4ls.w V^Kn*4 Eu6J`az)/vb$wIH@!4}e"vZ @6DmyګV)D>{=^W+^y;mfAl' >Pt[={S#gR D ^m*kJJE-vv 0mn?F S09}Wxq fO[5Z > z;%=)e,RSW0EqIyo M ;jwyH]*eZʚNbjwH༼a\Vfe(ā #HD7hNL 1[8oꘑiU*G_mJ7m}n@_m\eX=Sh֘ +Tk줞26H`bOzAR?>-Eep{ĥSNvuG户IDŽr[@+Pfǎw9GqW}cvnu%(y &]Wq,A4jKۓ:4GVCltifcR r^<|3v '3$_qiشkT2<-7 <%G/KQ^+L3<'ֹmltg/uMc?1Az).A>[ :֩V@=Ǔ݊rouf cǵmsw'Tjh V&zM* WT>4`n=#kt^o\ڼm6|$^tft~疂`y$u~;zY:&D8YfX5]JC9_xDcڳɢ^>zCF4?Oq:oi|n";LرӌΉ tYb敂|w<m%{ЬgxhGٸVmjpg"sa>cbxv9NSğÜ֠ 0n 0V_Y/-\91Gvu QAU'B4S 3*}sQ|"d(PVU+6oW ]p?T!O9G┷P+qc)n[١$)71 'wbLnbLڢ=]oŶӱ}6[qk6*um-P>ۃ껸|6'HύϺd"*~)=nt 7IseHP-НP~?ӱ $qzV45Pn:%۬[B%40@367<^Hn3Z`!Y[$͈.6Ƀ6~7c'KJPBU^]ә&C'=nSXT\>4kUf474_PτTGa+|xEZ9'`asu sAbsйBHX{%8`ta'L-ߡB/g ߌ䢶Q0Kk=#,S S5 / Z9d46OqDȕNFBK~$"ԏNJ^Kp.dV.. !&@%͌ʡW.Sw0e=h+wna'R6$K;Q;mZH+6JaܡqhfҞz-Kqn|ğ鳺 8)FlmNz۽y̼gGpwhGݶC(KtU ' /^عi5X;0.c'+Aa+\$Vq G = %e)^6B"O'$hќ#Ff@OؤM +E,QB88F]ىUoWfgQa* !zD"һ"NGU?ǝ`FӪDqrsk(GV騩JRl`^]'Tʟ5cp$39N{FW*%k{];Nx\HE\pp-߲{un<9}v \23:7 O>.f6UVVrrrcZY+mh/#?K} )iJ >ym!Uhbʰ27^'/endstream endobj 479 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4503 >> stream xXypTU!pE0`ϻy &,eWeI ޝ޻N^[Ё$YqAeuN[zNC`YMT>T^TAAAߗ攔}rsͿ=/{{$,BfAT[gUT%R|uچ/n\ZeÏ3q'>9i*E P "%zzZLI͢fSc9\Yj<<5zO=A RөA]TRbJHq$T.h`33 /{g| T7z }C pm`o;qw):Ǝc 7_w HyEMv3d*DԧpCg㚠lA 胆51-PF# YXv ɔ/5)6\ [K`W ^m.{ ?-cjZ5 x T=Eyф]ha4%wGT S*ea}g/TWD)M?Յbmu-]ݐioR|]6Hn>>CE _\YHMuf N|]Ȟ{^{kS31и /}Ҩp n tꠋ>}nxhw.97cSV^ys!ق݅ѹ.ƦעGHh5^T󦅋־ Z i)oCYxd7:?`SҰU$!A: E&eѨNtVaRpCo8\ 0CD@0cAݗ[*AsP?.[* ^ Z<{Ӟc#Sj}N^ -AЌ$ Z&C\eB46^Q($6BQD0 3$ SĀk'~A*JD28/XqϡY?zlYa#] 2GwE|{M61/yrlmq=:nȴZ+ mpmDK< OF_BLsդ+# [hFʄR-@8]\Sъ,(/B(CY R˃$%ԉ@#WU = Th h͡N_̥𓟁fW.So|a᷹^lVֈ8 [튀sS u3LRnPIkʕU)^&/lxuCq:mqY^Z7'z@NĪ;r28 %%%ۦvB vzohO`wq|\||䑘DLsl%pkt2iؐ|~:ߧd1? n xxC6T Y*i{}p?7lC\We.M. o4CqVjjU&RD#IAm?]װkXCA&HVƸf)_| >P?+S+eA]-O>4 IfCؽhzqG2WN1/GZ~y_ϔ5pʹ4^k{I,qaxeASyyuVyRl)z3G"õԵ8[ s3Ntހ &/7MtC0Ź?gR"なVJF$7$#OHYC ɫv/#!1hDݦsI(=J2ǧ< ||nוc7vZ!MuQu 2MDc弎hmF%)}ߣ?LonZ^|ǣ#p? >OTx@ӕ]# $~9$'1]{vP[T\>\8i=@`7@ܲi3|N?,<;m*i-Qz6-s{ma:lk\9\ṛځG#|p/vQ>F +рXVjP\/Cע>kQo]KM-̢!"u2r.yKw./ق\n@//F ;&No=~O]xp )jy٫pvR/'.TwQFٮ<%j DqG1xht5jȘ^iJ>Tv@ÿmƴ&HcAw2M@ %RXW\S[S] auwz-N4wL鬮#~JHg>iPʘ@@9ySM3O:KFNysѯۿ떹9#xժ%K9d Zt:Ϧ9ot1IvnR"CЫ٢k]h&Dk=<)bEHxܐp6Rs*U~ۓmGgō1kZȰm$SaH6Gul k$$^/@OЍі6n05S+TvW ; ]yGg̏|]h-oN]PEf12?|c`*4 k(a$Dz"cZmV- wҷo=r#ҹU*HLtڝd$QT^UQU<[v6t1grҭrS*#&?Cj/Z@o7ntfJZi=TL%]} Tj$Ǎ [Zwn ɢԚ:(f6yߦ:Xݑߛi<|&@ t(h{<Uz4ow< c@/+ɅDGuz`v[slHz#<.eU>u$XWs.SqxP!"3Lu':-2 ΢!h;k@4I@Vd7?^gF $"TR #cl}h,}ᛮeehI %D(KA}Vwm2'o6RJ",wOO5<YD*"UߙmB;j@ xz ]pa;f_qvsε ߅gg{eu=)dTتX?ix-MOz~:zP6/=uBpkib@7!I#E2q[75+duc%-uœ8],ou}Gs_b=\(.(Vg]ﴼ}y05}RTTVQ*ZJ0@)%iq+O6:e˕[;6^Ae-24#]Tb+f~yA.'q!#$akԊ9_o$#A1vIܬ䬴o*| 2ҋ ⼃f?ݗzS7'}eE!I; %` j}ޞrdzaҌ$wDSex$1"4Cvc0E*E.h(}dDA9OdĶ`D,lQxԓ&=E٢(vmڇd|冣2~>^3cuA5,VV(dO^EƣGPQzÅ#&;_ k88Fbhz=s^3o >tgN_m~db'A&unmR7Ǥ+788ZB+:q A\WFt@ ldƣUNѦ\oH!CH+V">)endstream endobj 480 0 obj << /Filter /FlateDecode /Length 4417 >> stream xZKoȑ4sؓ 2h2 ×1k/v^[1{5_L>D{]Ud>""#"?yy[|S>|S|Ͻ (oK)skܭ6Rޝo~v{as~xj.*L^evƾ~}l'sʬ:au|7umvۗ>{j̦M=P Wݾ -})LtiT7 nMuqϻ)a_ۻ'&Н/ױBqY*{c|#KՏxQ#jͪkrڶi]rȾ{i[x=|BUh%Mti: !\F"W`9! Zh8ÈoN09Ϛp or&{}Z/(!C wNz`k{@I}6p\-3k6WB;3v{) g u$3oW.̀u I*<&'(҂GUJxx1p* D`uׅ=ݹ95Q}rf/Ֆ|jtB5e`6')o4Zq=2AlXSKbf@qƢ:Q z&@^ggVy)2%a&a,L08ooJ/hooyeGGtytkϳ`Dc= cNZ'T ?JG1gU=;z`:n{ȷ/B[Y`w0{oN9F=ﾆn)jbΒOWT ]j’3"aa14xrD.jR!pS$M)nCaOJ`-$+ MCP=}0<% i'O1`dA0 ]\AU㿻qJS5lgjAvk g7.sQ!k?i10 єsEv\ϸN0e'DDq87,c:BRJpDOJQk)i=E!=q$[nWmB_.ZM0Ajcd nzIi5/0&X@s]DK#A|hf0Q@H7zRovdwN{bzmc.f&T61#,-E$STu|"y/u`deUtvn!d}2ʇ0"Kc5nmș+Hs> d \-bJFEc!WgaS,za~1\W >b Ƣ(s-UT /KW*S@HopH$X'&JS*,qNY[R#ĺ"Tze9ܞ8ftR(>4-8.П s hH3,O*\S=&g{u-{W&CJaxGNֆ}QUe])Y(%?]>f4(# biݺ*k"`z1>. e.b'*|&8#/̆%^vƂgpID5iQ8caE 2pff)O`OL-jI"6ʴBvAZݼ][44r Rat3OY%Pf[Q "uM'xXO+4@G逯Ӝ5nC @"*8oit給-Cu^Jj/s A˾~W[HH'1zҰRKQ}ZpxZ{H}뚈U{jV;3)t (vs|ݵ9&0ѡj"'V-/'J~jpډ8R}wav&!IцPƾSl]X`PJ~GE/=abqG+ Dcic@\ܕo_>(zyV #I+W׆ʨs \M|:9a@'TõpʤfvEJ*WG,N^kwNj JZY0""/spRGTCe}v ^M68!MySg'".qaä5@SO&v:$^Cpp \p,nzM +ҞJlԟjN@QB_R:L灔ی}8T:&ae^t.5>eH6BkB6b##(p̺ґ$L{4•3}e2tQSM n঍#Ec[De¯0h ^a>M8{=@Y.sRbZx'9l` bfc[+DC9aR7.C!A.C"Ab٣|y* :\߄aR~ #d~ ᣐ'R(eÀ׮HKpL_Y lBW2Du~u[L#7?"[&%-D*_ՀN""(DPdbs_K &PnXSY%c ?S*NnP|CemM|;Z$udY/c?<|Umeg -<ˋ ʵ+S#st :51p! !]-SN߅0Ǥb<:E버 M}88ÅfWҩ{7wKgڼVL=4/<1.u5R `j▙D!|w?ǘtendstream endobj 481 0 obj << /Filter /FlateDecode /Length 4088 >> stream xZYqs?gh %u;:i5^Yn1v;,EWDd&jLk2adq|Ed3~tnpz{۝n{iy3o 3-2m3!m6[E=gn#\ҳf+\͖g9J3Y.XOyp400%Uˍ 8;Mz%ijWw&}?c5~oF¾޲9W- ךzÆSwpIL-@U{P̰\4$qc +3  [)Iy}'oAV:+*̩p^+˾0p~%oE3`άHn`{es˯쥌_KХWze:~;C [jC n[/ ynO('UfNFI_qH"0b'Qۗ?hVe`H4Z:W_@k ;~pϹ[3L^2iŲSL9T¾ rȭށaSUv,C Die=@uL\C!8`!Å^ >\/Trh{g%|u~$ D6Beehtߡbr³OX8t9K'^ n xY@ -QgBq-"R +'8@[WЕ!o3ȁ3L.y€Z 'L&uC ϽZ2 %y@F/ʣrMpDDñP rӳ :?UeCIPKuNZv>$"MCXc9 W/%?[KŋiI ̠xI)rl[@{jѳ<*8^h4fܘ }AMj@+^OfW֐QUrcM;9G=vM5"Ht%gs.q2`Cy]Ӌu~ H,kd"!?$uΔI/2$nE.-+MfMӟ!2df2t.]1F#4TtsٻǢ_]'0ڥ3.4O>O@J)Y! "ḏ%Te "69<`ni-,q WKjlT轫c~x]S3S gU9XDQ,&H SS$3TXlV" ʁ{GkC: }`Jql]u?cO+kklu\Y(C'RIk64ۉ!=B JsQ m/ 3Ve[$Љ4xAFc!~~0Pbc5e-:}8Է4UBP*4+Qbp 1yH8 QbfEk,YIҦ>FyS zLvT}C, ^B$텮m%%b٠jq0 5&М\@ x_(QMH7mTLXki]6eM|i9m+0֔JW6#E=)Sg3('>}5s'V6HX}CO=u- @;N\TqdlUʱn[Jbm39sx78#o ~8Mjܗ!`z,}!9ԇbђ53!% OyD34JYP1-п+U~C_M8-eKEylPt}5%F{V.38~\<`_4+VaG"a522G #Z1aȜa/8=wţAhY C/`Fϝ05@2bٸOwQqКq=I 6΀r*0.^MNpn&9I:e.ϰ=򄞒 ]JxA 6|P{ɱ!pODj}\m_t4OX;] +NC#"=Q"?-j z!H ?qCgD$,#9aW [i&ad&f9=D}PXIHC }8Pbs\=T1@|`d@Ե"M0vQ-vwbQ3`%DBqwhv!{p;E ʹ)*!"[g`4u(1&#D-Mt^tNنs<8M2,",vP 'fݟOڮ1}| %qKEWߴUݠ;z IܼܭUN7lPUa~;F;'Ȟ8벻l8%(-1y#YKJt;`Ş!#O۬(؎,w"&ZhН˵Ȓȶl i <Q X#Bt^}>^+j˝<}z"•sБ rrH.8H1fϨ;TFZIwϖuӉ6'hfa0v(O#?0x*ݓ ې!ss#׌cLh{N#paJCML (ĩ<7'cNLexVD=[^aT y.b8$S_:`+jUCbC,o("]XCxH@up ģlj B;h7NJ7UC[Hɛj|& $(MN\iDW7Smendstream endobj 482 0 obj << /Filter /FlateDecode /Length 3443 >> stream xYMsܸN)LCAA:;hIS)CОΒ9upTr*)UI$45y~j{~>OX kΐh[NlҜEd+*riɂRҺܴǙzK0w@DˆCOn$1- A+=- +}$]q CM;F'&(1dv;bd9=ExR<- C:9a%[XgV(Z4m\"EnP3MuDUe73$QDuBk?)Qe74H^+Ig]_tIFZ^X'˪`+ EesNVFx=Rw=͞Cr6>̡>abCn1Uzj c @H@S W>:6%8#򍐢ڔ}gF>Y3Ֆog4K!-z&)d<$Y2`(ԝn?0|-7kRx6dOi6X'd?4 \7&L%vnU;։<&5#a-wo¤٘Eogq ¶(&};e92'c~m35D9tRƻH5P6wh]k(դp6Ǚ(6 BQ!cTag\!R{?jp`g6P_HlP>SJQ%Eߟb8901CyD%er]@qGj9dbo;U@DCWG4+PBѾiZ 4)2~3z"kh$!tvRO\ ˠSv*r8l}5/ 'q=eB/_qgaz۪ ؈= Ƨ=rv^v!^f76PB 8Iu.D#ȮpCrnjD3@ӗnt #FߍH+&Uӑ~s*H6_&73gG3P{+F8yR9*%;#>@(8ƪjcLbvf _ȓ̑" U =m3|(+nXqs7p];l6y- xT)+ 37h; ><~U?P|U  /q~s$YCV8*(_N߇ijuSp7!̱aGe+CTJD :`5 jRH/%, -)^Α?+?0W\6-ϸ]s\1IMoxyT :*:p y˿_i`$ >xNGEғ?˅f8d<9QgH: 6a"" u~YZ1[k##ϙܐ#1EtLJ]S <{ò <3t6_7D{ &}= }Ga8pgȷtI}*]hXOZ٢gfq3Tqx8zLb&=6"ð^\,}Y  nR/kDܦD^WʘCn۠``~|2!LIWeqD&I7 $%?"+Ԗ Fvj5` #u`A͇/_>]2d פ\p>)1Gͦ2HYLW[o6n I,sw4>Bx(4sp;"a :ixeAg1տ#:f wcq :B\v]9b( I3lrZwA9xa0Yi5AI0ZET"y;LlyC^^3ߵ(XӖ܋yj|gq"0j.3ܨ~1,%uQI)GAz m*LQlW_>+Y3 Ԝ <̗};?ա>|u,^%Գ;$"!NP= Osqur3D$h!i8{dFZrM ^`qW#k۵yx&8^2nxe^>g9WaԈ5ԏ5YTV2)]rj_Ag\x]nAEnK |@˂+! &$HJ =&7%$LTQp] I5(;S@SB1ܿX,^ӪS\h4Vϣ tAGXќK-Jx/%(ߞ?(Kqendstream endobj 483 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2476 >> stream xuV TSg}!s ĶL.*vjub(%) *AY~X xSu\hU:alvXK{yA̙%{(WJ$ ۷׹"imn0_ ]˗qɅ(3>!qsR& <=ȝ1q+VkAvQR*zS?BmBʝ(jКb( uGc.w;uk]6]KL;+bWXǜ =@Z%{2}}iT"M ;vHM I{!NF.1ܔKy?vd2?E}}kYnʈҹ 6ܠ n@3z8 ?O6`j/72y4H.00\|xwKKouݒt\ m6Т= њȬ(P.34c%!<>es,(,Aω´7  { wWLgwʏXF@0kK@X`J?;m!u3dBJ^>4{% A(ŽZtMME{OGD$GG?gtV0%4,Xt+4٨QmGʓlGR^ R2f>4' 2XrpOsvUcbKԈnĥ\.Uhsxu'0g“D PY8h4Dp%.٭Q;CIZSC*tFQng ϔ[UĖЭYPWj̰{y61zYp q5y d[J7WTT+ӳ@42+cT/n(/_JMcpH+x7]IքǞ7H% jL8x.{uP'SQ='،> y*>-iF)Ae'*rL!œ;H5J(bIͽ`$҄F'w+%eV`ύ'ȒWayQ)jpQ3Zo2dg5oj+Ke^g1yN,7,/mjnheղ!YWojS T;]^du(F(5@SF͒ް~eB :ȏLOդi_V{y&$)_ozߺ30Q17U0V}0 / f.9ȌK "Ublr|Tf$w ='ek, u UBЕdI h!ߨmj|̻ؓkw22Al%#+FX--[@AΠKa>Yc1W5C3%n9l)dPՠt?~ho7 ڊmݫ7#vIp@ #p&,. aFtH)S/b,䓔 m=K*dksz:GuɡB,I|Ҍ .4`ZێLk˘ t]ڠ ف𤭰[OòJs-Tsr!R2{R~r7% ڊa=zown_Tmh1]RT]7.oz\#w1Q1MÅзW&0@>2"^4FoҹqPw-۶f;f)]EG;Ox fu\5nDsΖ~ȳK:#Ig3f00^vrnA]4EPuFrϵyeY a)4fG|<-?|{r~>1\{4fnpq0 H2_h /]YuHkk 75Ɵn=:W@A_ s+0$@ͪߍmr,lDcspcJ r ~wl_Kd `8WPB$/O_Y:ӅIˆ/4GB0$ ^ZI |9f)iUX%r|{b6>}ސ}DŽ8{§ՎIɻmj;X!6XcJe J]=P )Ω2VOsSI> stream xXytSe޾!/[jr0ʸ} P@B҅MtIz_=m4ݛ,e/P-(ʌrޔ3{23̜ӓ a) 'xl I|It_ Tgn0rMpMpo~&UB\Qc74=Rm0t༠uapcٔ^P)B98KHϠ X}v>}D;@T:V)]b݊Յ=qX zk4;}OEPƕc  #x =uI؋UN \*KkfZéY<$2(LqCO9OfS1Y-޼uwB*WvbgM2YJZ BW(Yckll6|@%GEd\I@,jM\6"3oU+3  i@ x gymu29+UYh=]J K*ZD2N'9m%9ڌVY[~w |Yf˹U@G&i P cl` +u} Nz/&oDl5NIٴfnT~T:Ϊљ n2:\ہPK/|1 +Z B!l̵gdKҶ?pĺ:1(S:.w/I(jm'z:@^2R{Oph). jp1C(TT*B2 WaLLwˋ 9bnߚ+Dh91lߕ/b0:\G^h1c-zL}qnү+P]y[j9!-4nbj\*<çB,5e Z[jŋV߻(=R۔JHͦ<Ex0%,SP`0TJXWj:JQXsd[2|/3.GUc#zSi؅@\ztwF[@:FhHz .tՁQ{z7Wd$Fqǐ5,0YBǥzU8~brB J"\`uYlكxЅLMI$w/uIYPe#AV?-xU 4Z(X>-.ue6 )Sxּ+5_qA _EZ76[e2nU撓G[єڃ\ޮaM|ȜF%Q&nhA@p ZT4њ -KHܻ ș-7V!Xqn48Ԙ2?M S/8yp "(<c1%Y4vz%TВexѬ(xN?6OᶾLâ~= LP08S<={u|7;tn m?h1X9tO5_DW$?ۼc4<]6^_'^;69 "씢 D6<:VKohhY|7 Ȕ?sG ΡqhzUtr*]#Y$'j&Ox ):Zf/Y(:UZ[9ᅫ/N: VO 'kp/q]<4q7}jKCojh:SIv`hg4mɇ5ϝK:Mv.4A8.8d 3yFN".H3ޢƆFoL룉b#ӕjqvf>,4' ":6\+hPmgO<}hoUyܨc4{7^%wRC\>RpыX`%/ugTOʮ[u_!t`Ag5Wrf n~jm;wp0:"FV^nhtHvdmW-dS-"AWSBo1νU-hP=Ѱd>R ɔ:G5;ׯwA.b=?{mO< |dV"_"2D4G l̔96WF@HsW&l Y4t;ơ66 S}gN$ʊjB;}l?x3[gXcF C:Kea:qy2v{ rt<}hߕ{}pʜrR_(I[_n$#O7$zߞU]fɆeUTײariԯ[woA(@+Bk`ew'gg6p&``З,I^)%U[-˓~ }LsN]ffNNff]Nss]]31<6܌ NV ncq) ,okAp(]g%~k@QK Y0,O,J?06/'"]r_dd=Vqo.@wo]cGWցBF oVezǞ%Zvdk"YPj >!!-,Iׁ: J ۵.m|Q]˥ȭPuqYp[eQX!oxhRPZ4^5 `Pdl.w›8CoC`G,a7o\=6iK/xҦ1i<9ٖݤt:SWCn 5&=4 W/EyG)(]G@WUL+("fε/s\~{FW&lص3]( Ii5ӗo½F mH`pvȅ/k \ LVXv=~7i,yވ׀g_`,}Pv9㏬ `r<7NnQT-$lKQ İAVFD[ŇHP9?_aE9C0;h tWk xx zkZ"[성O'3endstream endobj 485 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2432 >> stream xUkp $U?*~heR*@&XB r\6n~ygM6&!q%`  "ZZ2U{v9qt9}yYNj_e30&lHCR\đ8iŻNMyىI5y KkDEE_J^XT\BzZEJ^ҨQPZjuO,Gu*o[\B ^,!'x ‹|B+P+qC/i^qLSR7}ۥ7Azh%(DT # ďjKY\K F6wI_i2&"16›K,r^/W0+W(Α@HDAJH-Y!s߸{t # 4REC<@H8~?~xk@iЩ@J=`oeы$+SQ6̋V^%ZUW6CmCke{a!أG. 2^1G]#\!~[ ϏgU 2ՕM P#^9ʴMmZR=+'΍w|MѲulUNn8紘ZV5g@Qq>n=NMfU=W1JCjQܣRf(TBM5HA9x!N{Ӷ2?GT8> ٬&`Cȝتs6`8(nآhǰ~Pd`0H>􂱌S ,3-`ڐ(CJ`z~ Lh3jX l z j>,%9hVW?h O* X vB0 q{ePgS[c38fvmH+aDw3~(滹Ņr[g<75ͦ}@S C ɝZFh˾cLG fEԼ-;:'wXgr:Yf Nt`OfV7.3{`dϡը%UR]*o!opY~4C.*DMnq8ǐ]?=C7f{}bK6ԕVJ VMN 0_fmc[f~agPVg&8KZ {+[?ǧz3/Pn <c-)x l hr[ꉒѫqm:5F+ZH ͖vp_I712ikҴZ+lދUZ\]YZ]f#'q8) De;šP?#=0a|= c}ws+cGoRѓ嗎@]oQ;q ;u}`E}Lϋχ y57<`qMs D|)$eZ֠kAM\ 2&1nYgRE -UMendstream endobj 486 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 350 >> stream xcd`ab`dddwu041e~uȰfwv0wLRC L|rť%y%%pNJfqANb%S@c;c3##Kޗ|69Kv3?D.0{ϋl9xUVcISz%zZ#HwU-s,a3^"[AWW< ɰ|(  eEemCg1IOk'ďlߥN9.|Nendstream endobj 487 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2818 >> stream xkTSWo^_XIoZﵣVĊjQ &<$* "I  ER2UmGjUu mgu͚3|w}g#(H$tD :qkC_5J,yˢl ycNt48PIyQ ʍZMSGM͢Rs%^!G%RD"HEqB`=A,s)6A+Y) |OЧ)5Wd^zO3β(-`8GЮ;J@S".дhBn)%m޻bG u)4speB^ `oRF&o+ii̔OxGRaL4o` %Y|}dG!"2b/Gr$e}~Djxa#MZhEE+}F1YiFgepՁo >DWK_&#lH׺7!MB9Ewׯ y#(҇'&ё\#钖`.LHSmׅ Ѐ^hȫtw(ęv4mFGEj4Mb&UڢJSq<ZPk9:&"0x]V\I; `Qq„#fizѳ|$y,7D&QO6:ФOs_ȖB7-;yZ83rѩs]q4Pr o]fwn8Ծk|̛*wqz Xz`]+*>/N+Th[L'hc KB\>fCל71)8I;߲G?w je[4bD\Yۤat*D!R]#162C<؞tO@ Cn}bUitlDq~V6-I6p6FU|P)R֘Kv@ +;ԔZ`nȨpu\''Fm0Y y:e>0:::d|]\ZD&.'qV~FA^b~_.s|vyl lfV s1qAh9:bg-W*ZVs+#3 ڹ e ;-ǎTW5[hxhK{Ԇ.u-h( ,dMkg~+ik *^lq^d-‚#b9*] ҤGy,Ӛͪ?zA'wnO8~gx+[̢ElqfK0- /"?!zԱpE`RSʏ M}qڞ*P2;wg,JOr-hbI'ε"]+LckǼp~XKӎ XG"C2lRٗz6HIKA~L lKH9)ALL>Q$6qrGp4ٚĒtJ[G)L._մ/~`~?fLpR7 1p.u2$\`7)K '4g>cGey\XPyY:DS Sen~QMBFqK? A F/ZtD.(XR- Z =#$vQ:'fίđv]Oq"r_ǃQr8y&y]^Ev]Qld\U'sxg-_ʓ$P9XBKA&I I!OI^ =GGAW&z'ywӁRBa|^?x✐ƾ3cnq[Yo,9䜹=ϣ]U^>|Ț-J:YJduv0n"[>y'7if#T3Ƞ\%Wl=] VR[Jơ?[cYP~ ""<6^kapvi2-, -,)),,ADunuq_wYZ_+j[U6Uw?ְ>YrV{n26_%͊f /mѫi Ly)yP Ɩ6?T|m\NA8Эݰ?xc2u;\'%{Iω×ٽS!o4ڞ^,%=V蕈ȴxe03%9mۛu<d6q% U>װlM`̴䂴4#pJϜ<}i~뉰oS]D9_ 3[uPd-6}S1N3-q ݃'Hl>sfIrx }ؾ8 0 Fx3Hp%P'{P٣@r*i߲o?WК%1z憆E.x026q& xyHo?-V#R+427PҩU:@EpQk5\ +r[7+GT}^/Mi>endstream endobj 488 0 obj << /Filter /FlateDecode /Length 237 >> stream x]n <opBI/MӶHr(A4=g;4!}`tfTk$;eƃMK~Lxi/c*d_+5uMqMt+c: sxg4ӿ#K;OY=i`*}'Pa ;>Io '׶]sC1sAF\(87L*ItB|DH{7S󒘖LHe7dvEendstream endobj 489 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1284 >> stream xumlSU]wYP!܆50G4D>I RX[/}lG#ԭA% j$4$лƘ'y'$$7m+ߵx8_}2<(A?0//Z<; &$)`q*LPwPQJ4JZ}P:AdjA7JJF3u `Zv-)!tkㄚMT.M!>$.yy>t[ 1)djF?F(mZ*cVpӺ6ըWS6P_GK߉?٥@' Ff(k;0{:F223B#^ ;(ʝBkP*beb|VDbȔ F`'&,n0Ƣ>#@ Y'%˹i2CoduBNӒIk8%)-W9SzL^;9 !Q:9 C]dvnl6Lt@B$@{DO!ȑC[}B]vcqbL)K07xx O ˶imGN:>TOиGV&Y&ނj»Ԗco16ӯ箞B 3H&ﳈYnǛA/ ͠uCXN]O{'$U*FJjz{gI3PyRǮ!2"0-*M5*mw;` 7d dd (.H0  B$}kvdS͇.E6  ;:ܻrH[!)toŤ572E Cxh! @_~o' Sö+S!g$7C:}5lKǐ"gΑsHUA}"=|R 4Z&3]pVYKE^951Koz6@PYc5Q0tWn}~#]z=㘸:.ҋ7P60 g`2̊4T<ܿRMEsQ#(T,[%/R\mp##;Y*<{i=Uk-V0APppvQFd #v1ۃ!Ǡ3-`+21=rZhgSV_Ϩu(l(׹nvt"[Vv؋8VrXP$`Aq6y,0z]`:A UTendstream endobj 490 0 obj << /Filter /FlateDecode /Length 197 >> stream x]=0 "7h? e)K.RehS@b?/E'Y`8ICpdQ(AvNoMEs4(iݢOⲪT.&;t8Fc1@WJCZ/dJ$+!! ~nE *K%YQ*,+8|i0L9tY|!Kqzb\endstream endobj 491 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 689 >> stream xU_HSaƿy ]f.9)RRS.DFŬH,mNscz1c:$ɋ4iJEEb]շ4oxyF1([Zo_8P2h[ʹBŐtHqA [65zNmTݽzmGQӥi: BHD:B#cvcN!1y܂srZ.i7һxq'-ߑ\#|[v&0u_I9' zOQ7 8~8 ėQV@y zV[66IRV};MJTVWHL)LP(c!YMH `@'Lng-z4 ALrR"B1wR2[!FWzls9Z̽ ϑ3Kw6YCc^Y"s{pva G ɿ\:כMDqIbiR"ޫ>CΙi xK&ccg}ɩ/_X,O!4 ߦ|xjN5q3'C42\ܚ(.dD?*%*UYZATQ$T4۴JFJM$ "J8 YغFXZ7g4Oendstream endobj 492 0 obj << /Filter /FlateDecode /Length 5382 >> stream x[KoFsl`Y΄v13;Ob$NC&nG&dԲNj>H32/"~JqUzzx+Ao՟n_oF]2Xin_qq%*WָR*su{}(WFkW^ xk- Q.Cn^?]lZXkj}5O]7k*Go:-C< hᩒki ЄFqxY]pwbѰ/WA~i7‹Roib8Tii{]s ͷڔN諕e0FD xwޗJtu_>xID).6VʖJ>JVxPi>mE{eub:!áH3ک;?tI qjm.m d4)l@٢8" )[(al+| 28r=@f Z$ZpҶxQl?Q - HoGd|¬R(DsFoP%j3X)['xT\McN%l>~񰕊pt4-#At`&s҄JoݛN.|&ߞ%JLlsw}/VJNLt 4M} J\4$#wxȝY:5 K )Ml77ߚg4Eݡ6x x )k&;UHTKIV-vj)Emb߀? M DI\h`M_**ґ(1ʛ"fB$,Jź^AQIt#f.=K>-+L|Kk|sևln= /sBoSVB)_1*oȳ[VL&=e焔W:HdŞv hv}S.^*l`dx z+ɯDZI;{!t=u3Rp0(t=֊i xbTm%ۈT "-$7.-h&-В$y +]Œ&y5hh$rٹѐ 9r[Jb15QoG1@[ @?ųduHs]*VRp ?K z׍0c/ /:y G"fn`KNȪDe?4MwxdWyZ kgALxu2{c !;Gf;f(tˡ5ȡ+= h)(%Ib;(<~lxP{.Atr\^M@g{* E< S0?{Xt)D`p`'M?Jz?DQq.l8_4V}sHTt1phNM6o@ AYol:yh)c}Hc{(V(w5À4WӤ ޮ+e)X&8 k2Ķ{RҤbiݵ`@L,8qIFdB3y3>F_ L]~59[(,6kIaפ'vy;Gi<5 N)v=mu6\ `ig vvW4Cy320!͇?t_ xۂH:Bi Mm1C D7HmqC{><.indsH++7 ,&- =V8 紉y^:s@?86Āh7qAD8T)cě1oh# G}HK-hNJ6c\9.L9dPlz%qA!#VB&f2ӛ,5csr:?t[_7lˏ`FT4]5V+X1Ճgqe{d*/%Bt~+#-a ^q6Y@ďxL)I9umk 8 a0esDyKoΗΛ>toȨ16A㻢X㲂2qnL+< =r=y|~6bbyO`yvW(: Ϯ~67)$paA |8˹$=˶}{f|2dLK)hy۳C4v4e4&Vёw5 "}J#W#F23UwŷqR*آ0d׶n?xkYWR[zx@tObz.[I>igHYבOf9GAQ)sN0Rf tIOMDuK;:,?=<3HY|I :,+ >3-EEEIP| .mc18ġ MkmB1JDiVGXNOV-lJW);,X0[Zݰٝh6*2H%i ^ʈ< /# {^LV|{V!3Ĥ)v%դB;EQǢ%j!(. <Hk2OVh$~(wդgJzW=T"M^ ԶXwȶ 4P녓X`vg~H Њ*G*piFw@#jAa!Nygn%`^Y&Li~&Fi F 8z1Imއ#2M9=FuJY>gfm*lt<U ո)P `{IByd`~ydǑE>]S&"h3axkBd(UH"|627;s.jb 5$%v< $%ꂢm$sm3ri`;+ 8lOw,>ffC50f0 ti1RПCY/TE"A-O9|#S #cz,mmq *uMr6 '1|2Fϋ`QvيOOp3EV7rH¡ /HJUXk8@bno@t{v؝6ԋaS 9 ԙrA N˷ULGO^VF =>i޷ڸt̵;K2:XRC\YEաZW,]cvJAQ:۴TL<({ZjY)ՋXTKH\[d`Iz^23q.J+T,?vPa"]ٱ͋Ǩ7fxOkJ}:ѵ1fIq@k_ KVNJR2Ζ70r' ,{ }t}e#7fv'U TP װ| .e.{gfBArBhR|}J*PXަ*b"*@%MX7/~LG**gt757ig7מŜ*_ sϺ|b7!c.vPuBIqVR^j( E;O5Ii΀Jqҋ,牧Z"ޭIY..*늑WdNߐ_>ECq*ŒEA2cj~^TLi"_ Iy*isȕħ)rEUh\şo_? ^endstream endobj 493 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1061 >> stream xmLSw f1{aQ1 L& B2!F,-Bh8{cc20e@4 M\P9!YIorN9'єiWՄx=@Oz轐m׃) M eΑ<^y=6.iw*zN}6Qy)e,-9.iT0)HL'zz=OJ5 $"* aeC;A.h&6=m;xFn QBx2JFz5 $wbvtNjIǞ؈2@~>{G@.@PZihɘ,])^йaf7'0x,bVScN:`F4;ymm5jj x٥ƫ–">|omJTr0*La~= F:Q:I/j˸$Ɉ Gsb 6[m/PJND?>(YDdϠ X htARIɋh fB4Ԛ,u À,LL 3g\C) qSkknj0L4 if[F:507w8 ';%o{kaIx܏)S|KǼpj:X m~/2endstream endobj 494 0 obj << /Filter /FlateDecode /Length 3724 >> stream xZKstۃ*¼gTq$e6q @ s{J7@3|u8I~w:JOGqz{V'wG7*'.ƨOGa?R&ָm">[]%Jya,$}8V0*Tpv^gEN U,[ϱU@`oI=η*['ܽ w7-s(`춭v[O4|2ueehD#ouEƞ.Y)>}d}UMƭ)O}Xu x[./>X؍ã2H2kphA>,2fYd[xWsiO֥;˝ tR1]i`WeX9Lf;.{(-|V]UeFmJU.Faޙ_yQEo_&#m]fqVqxL9b*>lheÔ6GZ-N TCQW|^^U.+4~Xܼc<+ݣc7,DY۹mZ C(jđpL8FXmՄq%" l(} .2?2qrƏEJ% "4 ;|,gZ&&H pt01C!ԧ ~ `H^!nN@-A8ȣ+Qyy7Fd3Z{VW<@xa&p<֭Fi8h-LYdKy>vFUaYSraج5HWyfͶWq Ui[s``~9HpTp><Ζaz)TK"+1&4-ؙPXh[fd]+| Ա(SQ bA h|W">A\3q=yeӔ>r> X{>>4P^<=)m>,h#t30Ͷ9Ymڼ. @!q& bK-a ~Ƭ&5V;,h,Q. l6*Md͆)&ߏ!t<(%lx|e,)~4" 0@&O͙GbF#4QbMTjũඟbB:bؗ i6t=b_`C$J3WmPh'.o<`}Hѓ)أ"`bX_7Kjۊ`? y;px s,%{)lf~qZj ۾qLM$hKS'OH[-Ƚn6!b Bb䌣Ц hy0мC~Y>)IRb  Ep KW{t({tfH9I/&RnUYšzhRM=:&;(Џw3@`JePAx EeV6uu_&A S+i YΖ Hhs<q??I4ΰAb Jo}\:NB81Gy&9?B"zP LAw8O b"9Ϯn"Jm@za4 ζk'\@M y<;/K8,Q%XԏS n@alV@AP& |'&:T 8&怨Vp֤<>R3 @{=#[KJ|`I 1`wc% Gȥr}f)g* e8Zi5(S ƻiH̚Rl _87Q)x ?We| ѭtp&o_]j_YC66-P"S"x; U"|*"B6qI辰S)\ ̘*C̾$ΉLx zE`3v6!kGsFزm7YPLagf{|&,b>w M + 5 9> 9BWvog(=Qy(``*v(S k3@ !CCG~Z xih_t Ok^nĩ=X!XK t1r$_Bw@2ԴS3B˞6INiGPf*@94h WyFօ L6)rTA~YmԪC rqH>A-1w!ZI}E^jMhxAZj7sn,}.? 頎wm FX"EQn2.0ioʝQ% t7 q*-\l%f-5" !nwXVhC`,&CGtPk<= i>g;添ؓԟ޽K(;h%&¨(6kˠ3x~ԓ)5]HRUи$,Z(ۧ!Jli{th#bK2oI+p9O: ӏVz-,;foendstream endobj 495 0 obj << /Filter /FlateDecode /Length 670 >> stream xmTo0 v蝣# ;$$uTe&;Pcz ih.S?ʫ88"ulH-cꟆCWi9_OIb}4^j`d Fvm,rŷxo~ݎES[-OFg#K{|!_h1s,ƺ9xb{ 瀴3t-4c4'?E;>7(7K; bCF>-F#B cFWu#B\ 뚃B70"CEްbΗ$K5ӮWȯv]!6 ԬT5?I<{ ]vm3TC)53Db`ML?sYnyp,>X/c3,`Π9$"<,FI*C:2ˬ| |Kt9/Bgܑ +P3‰-\Ln{;|{vB5I?TE&g)Ώ3?&$lendstream endobj 496 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2396 >> stream xmVyPwq&* IƤ"I4rP šFk2 @"`4!D]C6wRwc*ۣƪl_u{'\P"54hU~~+/K}va)KE|v?d9,ec͹ ]p#kyr!Es< i\/*mx}`?Hb]N騐*x3W_4=])ŗ f?\FOr+JĎH9*8l{H9_R9c^:?8>ҮN{F5u29>.]'7({Ə΍frP tNw@MkSI+/(΁2^yk k 5}&0O?)d'`+kUɶPB.7jTbk+ Fޠ7A.Sv L|/>~ܓ7f%'n|2}wҐM ulo+3P)bV^agx d)24:!l*qjmK*ɇ-.Ogp|N̠sVc>aJhJ rs억75Ic7ˊqm+ tAUu z gF3|d{2l P32 ֗4DFD){fMW*OW@kU嶲Ds)AE#c=9(toG[5kjL|"ƾlkg{[יȠYk,Ȅ URkh{:{q'W3׻>r}(beYÝ l{Θ/xS_e*N< WWu ",ŦBSamIۤu| `WRĜw7kaD)cY[' f'w˙ {_2 }0si큑&"gk:Kj[) ;&0Z؄Z˙FsuUxx(XG0V=̥x?>g. L#TٽKBFArTڃf}D)wK=o{!r0(wwK`16@PlN0[C+Ӽ*qVkDeGeN?K-O)~3$KnLі6# )k' dmT-k4GV6LԱJ:6#5wwHSӫ/X//ZYo2u"[#رvs-#0]<rV|IV-Nj}#nRKeMEˉٓF)w8)!a> stream xcd`ab`dd v 5400q$baa]H~= Pׁ? 7~H/(>GhXKdiVB~FM|w> stream xm}L.-!--ݗfKvR_ 14 9(^`c^l710 @64/mYؚJٖvѴ,b{Lh44w|=Ee֯[."`M1+hKTswXq9"r-QP4EG U"KdYmbL{t]"?@>! dwEOL *fIB- 7z jb8=CRw:}%Sgkt{ljK܌Ҷ(Q"< k-8]=~.4`I?Ww sÓY_W iw=Nt&TޠU))s# 1[' Y"3OϭB3ܭm@+8 qf7ыRQx ƻFCt6JAomZq0RX-N.eה؍c`2*TdzPx&x/Оa}&_Md›ji*RnهySnWs;>Z:g#TET[]8UY\{!y`̰3,RE/#!z mL([V|J:V*ߔs>E>m@|T9K2O@Яe'*0D(V(HpEui-ji衅V t)/)-6(%F`VF/tʓɷkra5:8\CA?XdZnd=edCDەo>(TjI]1}dbQk~ȡxz6A%\*}4Mh+1u|> stream xCMMI9J  lnkOL'˕Q1ԌVzN\llxUm#~r6aegyIV.ZIv{bYavl}pzh}Rڠk|vlqq`c8s~{⛤f(}3wz~y#Ӈ}{~QυpY|}Pa±Njy~XrH\nB>^f}xzs\NZZ`a[\ssf{ 7 Oendstream endobj 500 0 obj << /Filter /FlateDecode /Length 4118 >> stream xZM8ri6 s1Ԋ(Q0|فc`Ca3UQfJS]~A+U3F*%~/^4)]zt;oÿw/NJ +k"+c2l6N}^7ifP6[[8o^u5IL}iͥ?-ˤM+B?xFi ]J9v2||^fvj=oN@Ui{l>֧xi3T7[S@FS"J^6xUc`蚩]{+ehՠ=F=mДlO9A)G̕ˡOCU_T3DrYRҙT.}h2T{3 [;a zi^BH(aߐr4 ށ4[2$VO gryx8Jt)4AFU}YHUWaɨF=8ïa\KE}=\;/{Q_6A]X`8Ψst64N!Rop2Gl23*2:-uO, 2AYu06OJji:}DkrlÆáaI[jلUWLJGX3@}@ _>_/ӑәr ]h!(dT\=,7RgӤ0g 6*i ȳaD{`\' ?MWZ3BR9em\Qk:No=pcY|ҩGӖ^LzjN|%cM'eN-rr2M2깂#!5cGYjɂ)տÈfNFa_U[H00poL͡ia}&MjVvyB"ٮYMںt9HZڏ%9+%2 P$_\D~g 6W &t%/8YO}r.U# [+ݗ [v8z^OoT.8R ^LGpRrfoI注&z5V\,(pS'wt8Z]{~#@mσ0v«g`Eh\/!䫛LS~ a"zC.DBraT" J"MI|yZI#3#:x:m>) = #*re| gQOj &^t]?XSU-jrb9v }a]ݿ223 6(F:t8 )%;%.M.7 7lPҊW#OkVZd!s` 2zRഇ ;YLzop⼪ hS(kf%Rn` yI͑8w.f2VERJ4&vz0b~~d i.SRdÄ9 |#ay㙩#>䨧q]9@fٝ\,'OA^\h0Ʉ|eS(^vh_:W@d`Vz:cSaJ5m68 1+Odxap6,5SNB\Eܩ6is;}. Od(=J Z epjr-٪7 &)mm:a .o$)>d4 n8 \ѸZPOؑ[b8'5-[g`ґ){hd<1N\!߮z?'Qj RܒΟ6foHiϯ%dKj5wBK?0(,#݉FZ[nۧcYԇI7B2^i131D(' ޴1*anBK]|:LQfR;2zٵreiOY>f aPz݄㎲պ[4!b˳93ZVic 멭{&dKW< , IR}AxǪ0\(&8B54nDհMrY r|Ewc L2QW8uaT|CBDx^6Oեdžo)x"ga=[72s6HS ŰC`)5[mrR/ X"W"`JWAɗb['OkWr_-unyr5<؎ŧ1lFM0;I$uU̲*PDB#D= *aI(0+% bMY!Bp>*o}R:q`_KW &J,]cIaϑpM`o , n̈́wf Cݔ "ip{(r#5ĭ(Ks9{vf|6ѵT| C)y]}Y"vXQ'q/aB6آZu$,,q$fP*8us:$ D؝a`?E,^q^mlbҁ g1i7yf)dN_*S-N#p@0UKy]0ͤ_`Tt:0<'-&W8=ϑ?}C\Y9ei-x?U5Fn98]zBȵ4"衚F9v^E>vO#D`MfqLnK{(#"S?3+..1E&jp3 Hy= qCuzT(zLnTy>Ǩ{:4Qwk˵y+r "D<ߺB2K_uh۶Z1Qx M#`z<e2&`7ǟRdPB\쓚e\BIbD4()(7s{#*)G B"3/j_,)J=Vӗ}9[?lt_~CxD;}lΥkT5M~ZϬ^ ˮ^-"MQ[/kzL,ƛG-ٜTn %/<}Ai- PVA^.?$8}J~&CCw6CTµM1"9Qc&)x.m_W5j)ײ?&._Zu@_ơk= ҤȆ*)]]l յ*&quȍ^PqԸ޾vDo"TJCcXrH⧘ÒG4pk9͛OhOɤL}znYLn!,jy|F1Lkֽ4}.%W\ 5}%EgRpõ)Fm9v$ŻMcpVܚEa)yCؕ(;(OPORe$,q;;4aӾO@Gb+ɊɢrQg}Qe]@έp] >GJQuOydealQB]Ȓ> stream x[Kuv* 4z`xa'rri#o76ndk,-sU|5If1z:＊lTl2ߟ_eW߼&?o~/?7jSoݼygP*u6XR՗I׷ExO}W;Xa.!T ;T]WSVw7:Rak.,xӖt@Rɰ|~I 5:]\B&eXVxlY}K6%eaߢU&Hॕ<ɔ,-S@zZz6]"өyKg:;NUW'>ŧqɾ9?]zFe*JE(Q^H E7Ud%ѼE'0jwMEWƧAO۰[;8ǹ7*)=X}}  zKOCSIapI]ˮ+|`yWoˤ:z`Cy9yxx$3ڴ'39yNPX")( 8NakMft o릮)# D'$}LIYFxXM{`k SyPm rXzN_}Qèg g5+ LGk& J2\NPnL`w09q7˥glnJ;iNAT-a䳭VCWIVO dE@k?e-"TEӱE,MYG0<<%S)Xm)YH~S5uGDd90 j;®U0\W|Ք<4UA`pks)H><*͝C4cTh)9TF#s  \~6ZjD̗Zsͳ3^e#6tp`5{yXcٕ]0zP/1FQ`(,QgNh)p2sYtx $8vId$=Ť3m֎ƺ~Lj+Z#!-Pߋ9|D6 3Iy:ኖh}K)q K 9C! 0#54$zÂ[z~vp<Ր_CUd#P<0d4+j91T6@K4E"Sڄ7T{b^ac"T-wCS׫˸ +*R eg26(\ j,ˇIc\nt؊b%"&?_ MCI ,`:y^dbr6wo8.sBx&*FnF6 LO_+ـJeg|PW( hCm2 blȕ}aλ; ZQXwJT|RvkrVVE=Tz : ,0]2Aj]$!gXsߜ.gJI"R,;cWdnNdd^ h )ᏜM 2 mwp >DjPҸ'C1g:|bĝPgxŢpRs(aEpI{h;qq6c-Bpq=yQuq2&AcNcO<&H H[4-KJʑ\r\v!$䱬˖4ClyAb&OV?pt]Y!Ea[qǶ<.Kk<ĭcn5Ÿh+lҡ<jcGLi"I7"$Uf0aRd\>(O4A FZ'g YQj%d0&& tja Kh+ڈ8 &Q? 9Wi¨) ;+4mUR" @$_R=R3\;BaEoE=Auxhe0~ٺPuf3"CكV5Bf>,Plwc"pf0G6l eT[cQ7P)^` O"U *%D\PQ{팕I_*C`ppXHuB^iZ{/Ɋmf8B.IБ>>%؜wW\Naq΢U!PLsP,Rٙ\ڧ&bPݼD>M5W zulM[E03tIaBo,n}iƖ?caݡmYMU.>צxz W $ 3yR·c>'Lj,K%I{ )^WtrPb Vt$Gm[zC5{́ӧd䇗GA.q@Nz%NM.{@3_*4'%>duQVP/VZ0`ԝL}}TdnWf}?{9' Ir%hUo KAFsC Ae+xjM>7\PP_s >zBs*4 ^P?W}Z X0Bu§͚ͼ ! A z ܉i70gg`]i \j~uB+{5]7.(sYAn µvܒrX  5|-3fs&~(|c+/ĥL5/*lAUQi>(Μ+-z̴]|5[ p4iU |S$ȅG ;z&D,a]3I=5/y[h잽^.oūOx@'޳VZMxiH+ACDtoJs͙{ hPpmguԗ b5VaOb6)T/o[0+S]᥾O1| sCHO[;w i提{2GˁZ+8v0jk26mZ~-`H)ݧyhMP+^|䝃l=` @dN0Gicb-p2"0>y˯hkNկ<_Gr~/0Hr d-@BC;8|ך'&p?|شh5%*^%H,qɻgq#Sy,Msi6`8)ǁyLbendstream endobj 502 0 obj << /Filter /FlateDecode /Length 4352 >> stream xZKq6ۜlu3˞Ld`5m^7lӂbwSSbfz~If8 ]$/"㪩ŪӬ||#*W}Z:XiWoxX jgWKeV7n;e}ԍʪ?h@nXY,o |L/SwtSI9tpN(Jc bOS<4a4lOxNdWIt>Τ((zE7H0Du7FyxPfRȥgQC}Όᬤ)dVF*aE`Ep !2za`eڧ@J*2OO!lFPWѪ%[-1=4%~Q!:Yx)e41낼GoEr>jnBҶ" \@N ^!ɴ~}跈48ḻ{,aN6W2%2)tF.&j!MAYSW##e]}pbC^9 5OݡC /q,h6zk@;6,69E[l8!v y2? |w4]nei\ v`c>ڱrƫ<5J9p H\dsBhѧOOUA(اH.$`\ؓ}`tMu!ߡl v/%x@b7LU.ai48~X#h5,BǧH ߭t}=$E7"ƣ7kO1@s AX o=b{ACKx9a?)•a EJߐ!6rW~ 7[ΒEg/8'KpVqwOdI0MFM$^Xylg{yѓWXʂI8F4L T7FwZvm:h:' dzE+@QZ%Xօ|ON^Ds۟6JA"5OgU߂XWC*v6JR@\a;T0&(wvzt x7s#OӔ=!A@5$,$Acae ϥQ U1gh~` `O.l-EAȨR90&+H_7켯̨I2+I"AYqwkJr 9n5cZJ:"(Zi(lCx;}C8C([p*:]vISa4ӫX q4k=Cqb"@+Cu3j6()q,ȩH'A/{ ^Pk%f۴-Z*o" aF&8f4QylwUQn^a{J 7.&+ȸÀ~\Y@4—Y)r2_=!^QԁEBc>@% "$"p*h@J IsAl.J1--cHXgJFDS- (ls;፰i𷘿Xm[2P6><|7pاQ8ݴ{iߗ[#!2s*=/|!&,}Xį5']*xX܇MC  b&@\d zIlJ3%SÔZYzDTBahQtJJ]^?+dQJVBk +M#dekQi!?v^՗dFpG_r3pF,bQ}*6;QsZ3RbT#Vz!R%`LQb:9j񠔛ܜh$MXIRkj (7G VY1B )X vN^XL\&~f1p6Jdz,~;=CN)Sc+ЮǗT)5B@ @p , ^u gC|.`Y^^:0-uHe C%wU:ݮDOE:GBA~ zyC\kO1ծ#\%DC%+.R2V]JNmOxg;fd7KXr:{N!D47qSTח#}Ox:۩)A@i~u|C} ofsjK&ϐtm|Rn?Le T# `ֳRULV@>YZ`]|~b{08+U͒)P` CZ8 伈O\t,ЌI6U3 ^+ўJO Pmn=dXlx@Ė}Z-uU*IbFGKSc ΥZ!v1lxk4u1pjܡ 312lmUb2M}%gx;*f|]&Y{f'RTX1rdN-J9?_Ka֙4c?j0|^~Oim&p&x屹+TПQ7`rуW c":?>M7X>H}{K1((,Vs,CȁJyi9 K> df̈́j5)_ͬ[z]e я0$ huH=ߜ#VW!%vp38Ƈ"r{ԇ!sԞ;4}kendstream endobj 503 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3964 >> stream xWypTUrC^_=g qaq5aӀ ^,İ8(:\gdf{ho9"{Uޟ/JU*.&M&,KTxe?~X]MD&nU3*}1mڗuH:^oxq㦽ws߼w>\ZG6PPj&j3ZB=K-QOS+C*j+j-5FMfPrv&Sw(ulf NqsҊILpRpklzoYn~t׌3V̐Y}g3y?'L>UʰX)r\>st!.32#k瘗VP^ZB3cT3;F]v]H**qH*VTF] ^rP.*me= "/pU;PZim^x5"^?OߋQEoTEڳ_3o-"wE?\W_2~&ٝ6d7^BYqXS]<.7@NQ&I[3~ߑuT'P%m{Aپ="+@«O'h~+#8:fiGvv⭯=Lk+Wt49Γ¼̫ivt6覗ҵL~ּ eN6l{n5s_?oddKBp+Gm锌p2뢅C_UP7(v\YMHj5YiVf:dO!,-Ƿ5"L[ClCGuG1tU!%jGfav8+iXEcd^:tDP2 ojQ43eMC6^f w+KRT4P1~4lTG5YZXs@3t&ޔ:*e>izxxF E5vgݴGpje}ժ矧"u5^'㻫 xf.rxN8'&gSLpups/Q?.<8;Yd^Y_w(壃a#JDzj:* %XOSB]SzZ6V5#U;Mv#2BURϦ , >X"o KqYS g_ᗯ}AΦU>5ځ{P8ԢlT5T4G;Dߍ ur7 z(~UY-aitP寀G瘟FXK^Zd J {ej jΜg^IC[A#f#fT;!,C0 ô&*'ZzWڡiI````7 ECݙa{S+ʀ~dWcr}NNV26R2%R|" Z.KUF/c;3 ܦCϱϡ(v>=':z-F0 ( IF0E%4ajhRg@ FUbQΝ11esِ Fm|=aR-~rqp&nkU&"P -IJu({_މ`o1x[!?㘺t/ dU~BBKUm6^wꃿ2Yx K'G͈/Z$@KzbƔ:}逓.*T5Qu*'U0;IcYhJ2Cѥ/YߊKg?u1cp@9R(u2|:KNHK"\.II~*Qw(zDyw#O׭lB:YYx HDti,ů}o{'(>~~KlBᷪҫpAgޣs>y@Ÿn*Y-j)§!~$ZOi^\[<"m (J]n'?w,gj1/nݰ7<~a7RIHTv?F/<\"n(nj<~Z5m[eH7nt9^?qqy^6~fbm%YRm? 9.%6 'v,n*? ("8tXcck+vJV&3ȫ^{4R4!qA2#ég%K[Ơ%DTȿ۳?Yv/@JHJ~ $*;p j5 ȈV~ڡFj$R%y  "$eID2)]l)h!|}G87 H,ԤySFV mbz`BJlur;}h,A '[[:̈́/b@p;Z"\＾Ѐ.2[-Hw /Ng*ˎrT'1DX%:LzC)b`|4?߾Pc4Xi#ڤx{`J`۱7I M~}p:}xoҙj IVD>[rbp":W [-ZY|P3)U4Fayho@hՊǧEBszJS|ZˊruL!s\'r0MtZ@iXZtҺE/-ZC]iaiÍo&lcrD2 i̲'VEu\,*t&3{7iR:L; 0|OyO~;t PR҇j;NT|FLq3Kۓ1?r ]kK{]Fm|_-[dh"iOb?㹸/] q4 L*ց,=21Դ_;endstream endobj 504 0 obj << /Filter /FlateDecode /Length 3949 >> stream xZK>XL+"Ň ;p o`h53򪥶ק$EkØ4%>ů*,]vr󝠧t_}F;!EFTtCR7k=:iYȤj[l(hɹfjng&DT\nK!M;YYE U2= d*2i%{<%͘jwO}EZ<Q$}؀a36P VR~/DZj-x~9\Mt!nMTR.y6 iϻ=.`aj>9ss((dV4xeRe+XjGtrQaa& (KϬF'Pk50Ji'Lw&f)a΍"9qt-`AU_aF쇇j  sRz$m3|e8Ut//'u7֨^<(A߁8ZQ_xx ZtZ1a 姠nS%MVLR&CB-S!9xu\bmp"iu /jΨZV+4С2GD[>An襹\,4{3Ppr1ʦ,b+=D=ԸLR>Y,4(&߯kѨ1<5 ڠ5gVfX%nnt'l`oҒ&Nġ~h~bUp$+1΅*Y r\#v!^aH?r+S [|LU=W"w+ݡ]'1' U?d8p|8^WlDk߈'VJ6.n"vYцI &Gpz}jpѥAt/_&G߳Th`* INW"+Ā{ 8:4^y5[hg8nH tjsJ3< vG f2E[Rף[$ ,{Ѽ&ƔpICK{l0ZI^xBŻ}KSX>20\]ApvBuK2-FWkDqee9t8[adJ2'ޏ0yhP:5LEiW1j oJxH%k -xNk{f~.]\ #kS *h&REs"Bu"Jҟ,s 1pR)PV-d ,d87q1S,t_;I Z Ɯ %␆=JX1W1Obഖ'ku_vE.F>z!>iNnq`"apĈ#)lhob'|,481"#*D!ٝEqVCd|em2x;4v u. u5C&UML}Dc{(؛T60s&" %U/x"S&z^)#BU檘Za(W86pZ)+8Jaf#`.4}\* u\Tgܐ ?ox a>hYm3N>H|noJRp8n M16g:\Mhbh:?iDtsx\ .*("t8 = `d*e?A"!z';Q3TOx LL?PP7T4<1rEx-$"K `vD@ M ڨ2D(2@;1#*d}kF*xWn2*1Q3X[61{K|!l߀  sl$@tn_&FݒʑUI@%o |ZJ :*0qmJe "#FOm%LƄ|1d#uU77<-b%'K!\`D=a7(Ѹk?4%`\oٲD6@|qND m?'9;M͵95< =5-?@ LqT_ Һ`k$4Ne~Adƙ5O .OT>¦IpS =3W}G$.Y#rsfj_ݕ|7D _i>:g27.*~x[n2qWW_ ,U>EE0~e5+ZԞ~s6u`r8I%\IKI2" 2܁"bFMո5ZcpެdqEM| 5$n,J(Z+Բ X mu ^[|A߸Ft8yVL.%g{y&R.rVg`Fn]kS3\Tv@,Mgg0#$Q->k̼TmN+J76u+o7k\MK6BY/䒰$71H@.S|'u[RF *F8tKbv8 ?x\:JJL\Iz"t?9\JOͷ8J(CrR- iw;WFq}=V٥\64>wB,Q ȰL!Ӊר]N4*=UbM*57$ֳ j O/»SUks+m\ܮ~& "KpBnfHͣۻN_Ac k+$L]/Ӿ?U/⍸%Mp3&LM kD7AB w7&\t5ҌU/4n:L[qk mSG kե/7Ç*ǥ 13 t$ґdfԯ|s=loE&RWNc6iou:[*,,|@ 7yT-H/!آ14\YpƺiTw~M(oD_!YC Gj@C%O^^10So>ئ~)(ԫpJ4pCbIbHIT3)w)[:(]@r+2 8u$b6\~u-&˦߽c8Rn7\deў:v.껣 P 9>bil 8RwFKJ}5ZL jXt 䎀>󥛕(VG3-cMuPrKfR*\ PEW.0LE!q?q0&Cb747]swo*W(UTg& sƍF9A?L"̗B>5.`(CXv-W[g]-z/ ?Qendstream endobj 505 0 obj << /Filter /FlateDecode /Length 4509 >> stream xZK䶑I>[v袉ID"ɲ4ƲF}`UjHeGGA Hd~7i"oRWWՏ$w~7.qn_ y#Nl(moί&n&SYTB+vg-R<ֻڈ)w>}߷?T8[d$dʯ9&ɌSa|~.Ȗ^Pijw4-ɿuF< ͹llI Q~hyı Vb+bϥFL#/stLN O/tb nR1dmnorT ˡ);2\O~aaT wʡLa) [-Ԉs;d-=OSs|^4%7ֈpE_,)p]ߢXr Yd6WOCیhOm};ЉyuHO^KqV:')C*p/j3DP4#w;00+Pt }C=Lc"=`;loghB:RɱL*A1iXR[7m5qѢԌV 7SEΠġkBuw6?0l'ȀC)V!߄uL6:d9)Z2x$U85Y -[- deG%@RU6~<=ޚ*GzLحyܪWp@0.%d!lB {4#g#0U'P4#o%NI Ќ# -. c{L)uā/w@hCGLP=hٹ6'Eq0b ɋh6Hn;Ps9xp_CUuXi0b>{O  7a4hĽnaPɻ>-7ɒ+IjqǰWrHg2L)@˩/&!+r{a)#хN5*n;-~N<}"+,N r@.|x܉.)wգU@.529g ĬQXA#*gC|'D05z@N )YD%0Vtz &U-gJ B=uYJg]X!48zZʞ6N[#R nJW3kYf OMy{ύs;cb EՏMl Phv,i#oR.F smd t&z>=siBzM|ϔBfv4mZDNyp>Nᕳ&>y僋{VY4s=ME % w^)T U/b*2 WZ 3: §Ocl>lL dr I15}5؛fd{]f /ӲKcP9Z@ZHFF [b2Ӱ*o Bk@BZ1 [k_{X }aF÷z>wﾚM/}S-.T/|axw0ŁM =L*Bca|숗A)cA-EmqB nǢ 2:j(\?jb&rH8`ձan1}oZrHc-0.oBp@S"hi{ h8}b V3dLV _ z ~Pk(%Jґ-!+Ur?1v3Q(n-7?j?CHe\<|+ { 2,YU": + #lFe4X9Tg4;3$r!3-^8f6.Q\sSG_B2;~`cn&R .C||hlhh,so))u_p>XƔ4p9p?y hiȕDq'ZRo'}tm=^k^S>|er&pk<~됪cmB4ie;y^FKm/iӚQ =(K(lOmt T?{*epkvh߮Ep27_T菵T HZGJHDQ)9EʐJ N]F7(U1M_>`) SDzŠ'ynh,XTGP\Ō613MDr}Sӱ:am4D$@:} <LCDC]RyO~`ЖojKocQYrM p6MɊ}[1 ԱeZE=D{[9C?!ݛY* g1 ήԡO3ppp}՘*p2Y~.%@\%uB^VGQon!돢)x֞ kN X+C|ary @V@rD}Ba!5CR>op|H>ΣOzLEXxN[k )'\x)wDq3\;CY\a^qsHZab(q&5S0A7&8ӈF #_w u?~@ӹm[ C}&.^P? ! ihDpy))16x.ie#,^|YK k6c-7_%'G8Norlkb{op)m289 r=[1$S1rdF;,{o !d>o ˯u<=Բau}Aݛbg^4 "N/t_WO%րaR9b՗w v G> stream x\Kȑ^KtL[4_6f ?ʆ.`I*Q-JizGD&C%zчddRfָ6Rn77or}>ys6\jaTܹ;υVz|I a\8iў԰W>y^xkWI޹p~9w2s'nCs@,n&WWj77g^k>߲bzK\-\޻BqA)cˊ{ AbtT"Be[ dsdNqs.fGI%Lf\9?92aNO.2wfͩHD"ۗ~Oa*yw#I΀@rlSuVUO*5*e;^8 Ԣj5BrqcgV䫞 z[׾AKl3[:dv3X[qmg: JĠʖ;vtx&AnRkEֺ<=Ccz7F ~P w_A`Xq5DjCPRiئDߦ85 |4t&lޔ г̂/M.n<τ&%^+; XV%ScT|0 $: 0 e\f\;9'PȡڼlvS01;aSLL4A+gn>k,{,\XvuJ[cG+)˄hrm}D{?Ζj"Yq ܂]W hi,< 6y PlޖRKk$Qmp˥d-pdDs9G@Bh4 WFLpMV{?͑ êUِ4{8nbC hPLQ@ZN1c[Cu4_h<꩗^+;^/8؆`5XijH 5퟾{t:*1z`dN3]T~7ɸuU]|гB0\5oб)\`sUMǨ17bBA"I1Hv۬ >aL Hm#gCIoXQ~#CUHg2ł cI5c \apxc9fzƗsVr;o|aJQ HC 5$ #o1>1MBƕLS6jA bX˔IJ0%]ELpdY=L$Dn[6h!/iZ6փB(Z*c]#jZ^=B"=@IF>`JѨ*ZYT`]^S6* O= (.b%@u)>XŪrK4 Gл,T:fF cMG7ɨ=]@-J#.ň#ldJPimZ`'vVfԅx'GPnHRXM ":vvˢm{ҩ8TJv6D1MC[bꢠ`nT6"; *#8ٔ`nf ֧xi8 G20X@yLat~"{Xä7]RmEaͲz^,d!N0zg[hh*``5kMn!.:Ì&} }]bB0Uj2v*kt-Xqxȡ6ck=E5XS eׇ&E DDKU'#C}cAUľzF LF < MgD ':W)GqV񃃟~8q\#Bz ~9!X].b6,AcBj6/*Z~Ԧ&˶Ju>Ib Bwb^RF )[{P-ʑ v=s0u]Jbe\7Yn .ŴQ$1P#9Nr (`3~B#toؐ/F=4O Xu[SR`߶e^-p6nok&>3F ^Z3f)Y3׫HԐX412وτsƦԑ%툔;0(?@4T٪d8`e1U5?%'卞C(4&>@x,(QfLnЇ>xP@JU¬Ej5Pl=1NWjmR%cADIJڶ$%!n&DT ( UĕoB񖠵ɺڳ 4WZt,G]۲\{t*z/MA%#0vA=Q`NΔ +0(=ugۨcyd "sz565vP/݄s fXm F`FOa(r.P\U Rq#Z*HLd}@OTk"ӎkA휙 ]q~rT!\ݫ /Wg֎닳aIГ3K Y$sڨC`hZy  grcI]Pw:sfb4::򾉤ev p#ܑ88wɤ $;G#6 a:p6 M.Sa6LBCIm@,/szc7Q PB_OU|rKAhN' F"pӎzzgxֈ"#!dˮURmC_ &S)l|1eho lV> m $F'=LRT]?DIP+ @j,AZ0Dާ6 aiXn=e?'<O ÓS,:;%$%6tˁsz:l\bqdE02<0. 0 xܼb0đye Sk MOj:1u8%=8O<@ǂ*:%`бD8O*bg"VS}8RQ!*UK'b[)>,cMh傽*gp~0@(zͫ RĶ/6HBGnF Ov:ZrfUNh”7u/gχ*׾{UGVgBC OI?̈́~G\;=r1lBqo۝Cid$1;/A _^;#2C|Q6d} kBCBFǾ#:vQ3ao>^c,砄FP@8HI 88yp{Fh@96AA5eZc.>C\ӟUliQ ?6;Kk2n!o^Ȯy rX'(֑͙+:g!%cA>xQP9r*䳛kr s$B7ʡ:[;A|@74^N#9Ng٠S)iH-1|$C-Z]h+Oz%uP(t#NP#/eTSBX7rBgRK4> ra6dPoqxE40E^}\%vXK.@'|<1z2S cA tjb*u5ܐ>쎤>jIUҲMx@!r]VE,ꍳY`GL?)@J0ƽ/^P>Fjɩ酕dlAz5&dX-q1ŗ|xw?x*`K"} ;oy|nu*:x\t!zp;WFmaL5p\Qp*2׃N;'܋^ƙhQၪh})\M&I;:"$9M9_M':Y%\2djaDO7?҄@H![.˴JSN>ϝb3ϴ60Nl_҂iH=H77w(endstream endobj 507 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 605 >> stream xmHSqwZkZqiטEQ((6Ր}I%#Erښs|+7FEIEAV!˳7L|9p~!aFk9uxZWE1SNY6u2n,~#),V@Q+b"fhH'sDE"~Fy;G((}\>Wv'Uޅ9œ5S4!$,YXfL~uֱBO0 .j+ֲi 7Ձ>YڥgyTJRi@P,_T z~.x(rendstream endobj 508 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 153 >> stream xcd`ab`dddu 21$2黜>;@ѐA%GO?m>?~ Βs]Q?mQK8tt7(EƳ}tjˣ=]{*y>9.< Px3endstream endobj 509 0 obj << /Filter /FlateDecode /Length 5193 >> stream x\IuEA@l@8fc_$0G#̌h10dUF"uo{/"23ɑ:+3o p+q_;[?7wO~x"M3[|r˨P+'JUk\%]?a.Ż^i*xn'߱?L !t;lnl'TT:hcL[5>kν6qPTW\@9R+#l^[l87ތ,UBI/N+`}ad|S),Dxa`ڸ =2 웋`Y.sT;wUYa}47VZ9! x HeP nt%q'z #Md}D#ԗĴ$ᵝHC8(uF,c W« Hp!j{vD(qh֕BzeL(EQ*'kVfe(θ1A1G $7d^B>2%JD'6 }TRF`sù~̲$>FqF%nHgVJ=3 2JGoҵ[v[Gw}5~u3sКFk]!vt du.Jkz\, ~eP'ꔝ"5|%׎_] p QȄ!5?,mm\*cS ^ uX'S h{5>r0PofM~MDv0 DшquXNu/znfHqYOFv$QR@֯?~ja +8"I"vQU``hfM|/;;avgò^~b1yzQk-dTH61FԆcm`M77/z7ZiSU8?ϲjM#Zh_Y !/_ 7_~ԛKEkŦe{c" :FFfx QDzd+wkrq4b_ xgM{LΛ6抶 + V+Ar/OPPԃCwvܼM}hVkAC} Nܼi`RCk3(ç:bY m̷oCu'2[XD&(H%nO x;;NGD d'WhezÌud ҴL92F dBȬ94ف_5GA#;1E<ߌs> Z֧=‰5lX*)!.W-M@BqRm\UBu4)Es-,wi9d"HDVbuV?̓TthQ'мoG5 ]Wg$| Ŏ {lXؾrK2Wʐ]wX Dqla\ՠ[*x0Y!'}ۨ0Q.YfG8N9gsː-Y4, =~bohv#TR̃|{l*ng5ܟbN RK ) X1:йU"'}ԟ5*ZWˤtc gE.<<pZtU 5**B(7Ũ츚qޥnss I#htף\ʁpHFa &R"A}f.jA':dĐSMY2n/NIA#B3s%VO,& y0|xaӸrf@'(Wi#LHˈϐIqS| ;1Ȁ@H&FKmUm.ch(óݤo`K216 |A/9Y$"z6`/t\P (aM*sA]N \V8cNm0jFۆ:4_ NS0 2W'0|GFlec)\/@'=W&'R#|elyd>{jv\bbb^U}לN;}bzM (Ê=\.wDz;3YH=wO™-6gֳyPztlG.cQ)eYA;yuB='^)'Q,VG+wbA*=A|Xe'^)Urʭ-e+u8'dF3R)3E;u.C kK]a(a`#8RaE^zY R°ce$ç&ANOI ,U[FRB31! A#[bX_f5Y0 *]WЫ*.D|AW[zYːz5}]* <%Չ;sۻj[C{sыUGY{gE4庖(|}4B2oNAX"x6'] 7y8"LU*g^GD(-yѯWMNϔN4.ff9yo3W1U?=,t~SҢڏ V Öqq<@[3pٻ3h@,׀3` b5+06P%ٶsdp#Ar8zU'bm΅aéͿFOb&%EUt<2M4ğ"4 ⅾLJpw{rq6B|-t\WpT6[o}= 2.iǻafp)#' - ,OH*D T_-;|)轣KNHU@sǠU6B1/S(wּKnF?>Tor0g=igzxϮ ]w2LZ?ǧC;G kRorPM{}Z}9\nzKךٲ;FW,k9Eb4..;W8~=<2f{?/*}o'?3endstream endobj 510 0 obj << /Filter /FlateDecode /Length 4767 >> stream x[Kqŗ=w&tƱ U#҄/ۍُ!r띏*F6zfe~efwU)*?=o~x#]g{{_l]( wBYg+2w7-KW|zQ(+劗z{/}YUC78Ɇ7U)0.*+SIe]0[+3}yѰ2W?rG,]s6qMU(rU9[\ОOz]{D% E?ԧ]72,7]MWw8v X1si7$u%Im( Mמ'ƴHӃ0i+G:D&؞7PpPڝЮeBۗzڟ+Rpe~۝i@fw隴4U_¶_pٝہ<7 W Xz/ЌyBŒZvtQ?8\,wJ >;#BQ')Ax{J+矰K2y[JN3lm@6s R`LwX{F m=cʞMiNCebA2K.a7 jx֥cR; f9vݬ[;4N_|xnPK 4KST~e&ҫEUŒJ)h{|j]8^8YwC8+&*/C{$l+l|)2hҴkXh`DWmAVF#e🻛u!S%]⋟U Mk'8ӄRyxȀ'jM64τ_π|slPƎR\HZB BϥB9# $O\%[5K*cFP yO#A59G[SW,:_3_vUO4M$RiInZQ*Z'Ěwiκ3yS^ڕ ~ ҉6lq~?ф.viNOxyO:9gɳ9cwpE6!!/zIEj4Q 8KQl_[̇=w=8Wꡎ쉉)5v> d6eXz~4Sl>גSw>\yZ<f ąւJ ܎b<ppJF>zjxlgܐ/vIr S~ LS@O|䪈, UO0=},\a%nP$%8*%7*/Q9 V8(sVZD]<'M"4>MMHPr6;4Qt=l> i]KMfS7IܥOflV:tK2RO6?kGn Z x@sB0A.fsofa( P-E}y[TCH(ڕO&4-h - b `Zаnh)^k*K]H<'T}=4 >@lE>GYdhJ+3$Hn0x}hl1Gc.|ӲFd1Ʊ |Và葑)5V[M4-{`r_>g}=c;S1c;הQ`mbgaX0rX $(J0?:8H{x10dw:[:)CM/d H pK>6Ȥ5 ťϢř#Pھo K0"}!\{aKx7[]p 8Uj9*46'gȟ_Sn)4BJH1WHzirT6M4yMkn^u ,X1ߕ_ f_E- 1a$ix>Yc_G FVkj1bǪ*bލfΫ!Zp O+.T&ELl Yy2̡_ "2픟l#y,Ԥ%G|D* 7kNje#%]:иDV\AsL*:b/ɟ80ӎld c[ Pv1)%b'7u "E;^.pƎfCAJdJOenWyߘ }2'y֊*mvMvST#ć\p)Ajɑl6t.$Ns^"D{vyU20@6ϑ0Lq;M _ڡ&~zRõ<`n0EJbi٭&% söB*-`VbYhSͱ<]Kn! 󚐕9e9yDzYǐ-#+qH OpGX ](@{mL7SP.)Iz)R|9$9 Yr2cOKA7ruήiجq˪ ٛf1UI4eD&Zox]ߋNb,D_laX >a>k֔j2X r>Xk,'@k/Ԙ$,UZC$68,RiP`3gO1A#Bymz[$Hh9v T "b`?xͧhIqDץh]kQf3 zwLi3Mv!&e+JR?wZdnfiN)y[NShB~΅G>zA8Hi/,))sX_ܑ SŅlG/\g?T!֦ul99"m{~"zXot4xyCS[>f :ED _xMIi=Z}0T1O'$irr~,^>k _Z+hX\GgH-;8R36jdӎ?kGڄimg$(zE?Bʡۧ| hƈ߉COoWBzu6s)6܊SL\Gx~ iQJ3N]nI V]m`qbX]=UrT $ڀmF[c3Ή ) 05x 3ͨWQA/XpfH&P|kW4tWFI0-+?!i~`[SrL7EMת)i"1Mj Y_qņc["#FD rhVnUv c62.)2}9v]_'9/.t0?xŠf_ԶK׿@L7 C?ֳ۲Q'NT`u *`hX[K@Ô&Ɗo5;tZ_fi^b$E/+IQ݉SF%&6C46RE"Y؍CeY5M!UF~ 0@_W&u,B/3+0e pYbI35?- ?5 anVnk-{65"١s뢁{^촅 ?yZ#^m`^a)Y޷xy54dOPR?b+(wLL4Wo?7$endstream endobj 511 0 obj << /Filter /FlateDecode /Length 66364 >> stream x\}I,ռVqWPw+@b3`)Hvu^ycwGO~??Z9j;{y-_oOۿSs?u[^<}c,{ϒK<8 ƴ Q%a.AןV{k[c۔/R^LYĴ$25Lٴ a/a/=rαny-,! ² Qw^ 8-a5ǁsi;ۦܿj 6~+2U|pzm a#$L)w[ñ$&>wh 0~7q?f>)R/-߀^^/~=8,ox5Y׿VC@Z{1u{. }9TFoc=s]u':Z R<1]ĻY;g7q^wK3|r013ߑ0+Cm i"$Disƈ!nH Aۖc$zKt5‹~0֟~Kmi Q$`χV@AIuq=z<%uv8>"\Fϱ70ePqsC)xúz+>LJY߿c r)'o^7=qG/`L %.0%!.0nD y25K.XW]wʒ K#R/SE%q)K_1;m~*ܲx[01cmZ%ǫ}S4\~5Gbf^dİp]6C^^Z{K]1>(uxk|;[Z_xFq,蒰cRM ƋTH=ލL|{$~3΂G,b-1nC֐oչzxIJ!aa1iW&ޫW ůlLnť^7CKFם?#n`LxfL);Xi4ǁǬܘc:^12%uM^sKK8kϥ9$X6 a%!&qKŸoj3>fQ[,acfʒ= ,b㡱8qo ƴ(Sְ>z ƣ,/a/=m}J)k~|_abY/>Uq؝5 cZBi`Zr ⰓR+oX& Ȥc!q|]T\ǜ92W֐6 AJgKWj 6eC "z%88i\3+kjR;&'h%|}8.q)+޾$ R`Le̘u@ ޣJ/>&kVbxb hq NIc cڀ)m8$9oixWmx$eyڱbZaq&wa r!1m@B,C&m8vt9$Xr7e%׌man{6+q` l4Q%`f氏VkJ]ndp}} e5Dl݉1M81K. kH + M yr ^dMb7\|!I[ik݃o:V^!TIX[ x sKkxC;7Ţ)٩/a6Uշ3a|K%a.5ӆX4ľgiuSL 7Ts(֬FVwxk[Cb SuJCL@· ␰気_m֝su' 1S'{Q2px7mn*vI<c_\CY~; uߣr50{Iu,O0yXcV`H /BM-6"sC*3~`&X2|Ez:w+΄A 'wiR1MDRIϞ& ҇dH= |<%Ӝx<=]hiOsZh%% k Hb j( ᐐɑ~K{|ux_')(cq3i3>:㒀9n|j-/Լ-]nU:i_r9"nTľ6(,z&~<{n[nM+P0>cz9]q1l}͞ogKP^5=#V6 aJYT{[8DrToux!θ-z88&q1eyĵ7Zbi\2 HAb)L kj|!nS a{MF/6LujWm:^4Np݉1Wk+9$!3p 5TI10 xŊϛJȾOʅ>buWn2n;'ڵYژ¹dlT^\rbm]?=Tc'g; [1fL_Mz]zY^p 羊 7KlJ@J*a3C+xː9y1>(kJRs-7qW-ElJ:pielMmGr4)6 yN%ex Lcoa}b`i)0 HrXB֐g&1kGc_WMeB/v}pR/ q$KNXA٦6_D !h}m/ C$ 3b㏉sqJW޺IXӼ})8%`#氓7.Hy#%)KDhBz\ O Y8$!WFH$ #54۔ PH8xwKh8\9QbOk$MBm5l 岄F 8ۓH/8f\ꮍl08?(8\qo]_Ga. g;Vnۤ !/^Z{VCK¨a~+|b!y}{y`Xsn X1,_-w71^;rv ^cT_xΘNJCy<IГ* ưȇaVmR&CN>Ks7qstSN~2[~L,'*#1./$GF CAuJCǑuĿ0G- qspVGa"<0vXk(6:bNʥS5\)vŞJ*a=ؖ]%߿ضX3q|"ҧ>8"glEݛo+8pM N>Z{1bǦ6+aw="g{p4IXC( ܓ[CM $a/=N@|/)U H;k< "@V`LĿ[É b$ 3G+xgh0OlS&#zcWb ,pFK[XB3!<8I lh9a;)Q;vX#h ĬS5}:uCo`Lx/lS6C^k}DN^חq*K`u̓]7ǰ4v(I(HHCd ׶!cKC^8MZWl1|؎zb[&Cöe2wl-zWcSPk1+4@9g*x}vʍ[d2 2׭3q $ZnSpXCB6CN$Cz-QI٬}R.*tYĦ QV`PD dobsEkxB;W~;WLq{UP܂-NaCIj gݚRm1Kya{i qk} "O)qxd/l ǭrX'_V`( !`ʅ@T.YB[3>eUɲ1$$)&n[ 74A n~qlqc(3%M@vvރN[ )ջ)kA$Z)4]^1% yB6 R<2~U`%(S3^|PZ,zb$Jv5$VT딆]qH sKkxCn2qk4L^c'16-!B6 !Jlc#N$lX9cm F-_᭜C/i i0) $aMc^^Z{l%e")'2aAEV(e{I ǡ̃ ''7[by7Nm8fͭac؀(?sk8DmĨK /a/8fI=(rmxXSOU"Z昇UHAb\HJ;.5&iCh8 1G~q_L+& 5 B(DBryp [! )* &aG5rr ^CZwfaŋw*`ecĊqʃKMA1$a{i qpf81ZLmFV&8:O,h0 E)'6ma0iezWm2ݔɉs(f%`u[EL*aFvT-w{g~D«rxޔHYOi]8(i ֮L0L HquvR Sׇ`Z=kc^IX3k zz7RBN&B)+XX b95Fn̍ەgI8[[H[ ܃9cm%J5m ܖ 2z^$e*ܺe"6щyP`x3rđR!(.bù %1$'w;DaNgzV`H eV0)` n<·#T5U}mQ,Q VQ$! i#$RpdIH/ı? Қ3]u#< Hg9_T3'HN6 a f [âG:K 雼0G- q:4q.,ͤD%Xߔ(4GhZs6~侙BGŶbN͐S=>cӳ2;L7%Eq N5#syl4 DE*0Mʉͭ!s I>>Z{ 4p"(z Gbx)kbEAa1dV\ r 2 6.Z'%,cI/&iCc'>Z{*yd&BjRю:7 ur]#)ſ6C^CNZkY P8] 8s"_Xl?,,tqDRշڔaӾA9$a/=^wA)l5v3]`L83:K8DrfaicjR" t' p(+[b̿ ʴĦ@3x`h"]/ݍI̿)*;P`l}S1"q *=(V);iB8$9g^y֦L.Dc- 8TM 15uZ%Nʐ5] =`(ȊL}R13[%5[TI=kn~XiOq[ژ?? S*n̑.K{+2G M9^8X0!zph[֐LBRb v.  {a{i qQl3ԈT~V#dad½ c0\\4Q$m89ME2ԔBP-E<ɅrG8h1Ĵ Rb}(wŚcN19Y7?PE>(Q6 QdO<IR0G·cڀ)7t8|˧H=>jCE˭%|pĺS%@ (Az۔l/̑~K{'b|kəX_LH@jWĸ_P!zs ⌟P)Lٶ͑Ry^^;2 &@q<) s=4$L)\|XCm@S^#8|9e'm$=sF*N>Xbz9(n<4$>HJL5Ig{a{i q(W`^zʕ0e|M6NRv5+!~~Lat 1ag] 2ک a0X):|p\ clʐ5 6+/a/=Mݷ l]2ekg)zM(حEXnZvmjJCbmJ Fj`8Ki3d?Dv3r0pfdDu B6ܔ坤!"6cTO3dfL9kFr>c q6#J5tL P@)бΆUI)n.cN'5?/\K|c= @yvMźT+_!/q0ʪڒJ8U_!YQ~p_e\.7.K7 XS39e)xoDAe-6y4Y-6$XUP%`4MU@A# bOSƙ#8Af?2'sG5A54T6ד9oixC 1`nfF0/xPBa/㖄5$>LlBBq\ aHr25FmAGʦ8kxz'gM8N=`LHh%Xbmc 6em{a{i q(=PP?t #T'Tp R`L"y4?[ Ƒa= D]ΰP!@6  !*4gIX@}41T@i 5E0SXR&ӳuŭ-/ AuSCc6(ğ9"#XC>(+l& /rmvɠ*&f4ET[ sRGFq ז<@>}m7c;{%OW[IÖꇫؼTރY.Im=t<%CI͸#,7-h|]Z7SYV$q_9Elju$eS4wT 7G|V`H 0`+ =]{<=֦̓;mHA4D㒇>[NK=npVnZCK:WEĪc(,5DA5K.Z>7x[ 8oH7q"ErKc\x)2^4s:;/%1eU\zDliKaCP訤,S?NL)|hL.8J.$]88 ϪcOSO~'"t(* n),d`L崄4DA K^Z{X>x 2DH̟8E7k$F 2C#Pߤoj76҆0Erba oD$ບ._  )T0,k[ ƂⰏV8k]a)ȤL0ƭXRP(KmҴXWݔİ Q%LK  qgE}*{I¢ϝ*3GťYH{I95)Zz84-uȐn9gT+ːʔ2v9&BfRx DNNZk -}6%5BeZb6I#P_^xn%!mk ql8bCkR&G 1gv0eqJ*d 1HvR ޣPS p3,# m*]4u(Ja@H.0G( KV ev׿1s({g}egb=-!Sn Ƴ)$]08'+MiC'CJSwD(]^ %X46 3G+xll](\lXZ T). kH\tҰ;5oǼ6' sKkxC̍&3rSiF񉯫0B!m+HLOJA!@k1`(FԍZJ4;E&GesO*^‹ qBqZXU{cח'^}7{%l9d3GfCL)$&*G-h8Y9@1de$' LBMT7SLpmB[t"95FO@qIL3ع+-1fG ƴ;]QIqH sKkx-6o 0ȚS{(ga^*Ny,nLHB1E %p "sTN gɓ\$8m ]1p\:=ޔiPmS6&Ⱇhs2Y{EKI>L*2IAZ78O<0GL!hX @b| 1)@ fs2C$sSֿ?lP} 氋A,O68'%X G;mG\y?8.KHE F! o/a/=e1d;"N&9Rc_*`؄#FPars,i󓔨E j*`H6R~)%jaJ;8s7{isB>, Ɏ1&h妮>XCt9 ޣPz)C+;#>עtV%a<i H |~TR']%~6FHOo"N-!^7k=,m4LYp~~ÚZq;x+'ۚNJ@ aq[Ab<(yGƈǣ AC2Rv!9_>)ȍFmvP&Z#1Vje" iس$S؁G'> aIBCQ EndatҒ:Ÿ?ʁl+kh'a D?˒~A5 :^Ω0ŤL)Ճ 箃:seYt?8$I5 TPK9oixC(>| ܨW#KܔM1}8N5/ˍ2%a 붍Fy95ʢ-K5%Ɖ=;YnD>Lff_脱9ClMV(&͇b%sEkxBd e,)HZT0)Jc(ƀ10yr1e J(k$dCxS{% kxCS*bO {GRmn|+{cu9 ;YUI)q"a,EZ{Q2vI90 v05*TBC"s}k x Ӈ /(6i=/qXAil:|a ^Y2k5 a,qs)PktR{uy HofoQ2X _&G2#5l|D)_t=!56lH/8x'vcjR5>E~ R @D $)) ǩl0G- qpxLs)kq6qN0؟ mUJ:~k)x"'F 2A#?7|)O[6@r=8%rr鵘(zPY"I7}K| fZ*AsLIX1mDy(Q7\@6U">H=MknNo㞝uHJȵ:5Ǎ|7w [![?g{`;h !NzULY&]!"3be-֥Y'v:6I mlnIGoy'F l !8G3MQˡX/{UYF%ġ6>?I9"rQp%m@XKu%GwrPl 7Q{E",ůr)<2,5d* kH|(.)S{A;a8$95;MI8P6٩#^DԹc>lx|ǐ5:|P1$lcs{a[jxRYX-l9hŹ=-C$.*#)ǩ0T;a}G(FXms/WRZeYtxC2(;86`LM)pH6m/a/=Ϋgշr?=#.paSVTEշt ڶ@X`VOoK:IJ,l09#dGsH7@F'BQܝěsQer4hS$<(wLqkځSPy#6e UVjR:wdIC>>Z{\EO3mlʌ:D5N+hɭN*HxhMɢ,~~ Z="GM:RAcKxMC7%ʑF|5tw0}(9д8<~SngJk -?옉z`GT H szug`h A6pcB?YX\}⑉ q%QTX]$DiN mP^#?W:JF7ٔAf[Бp|pdicZD, [R-\tToǕP]PzRrhONQ Ž,_9֫y7IqKk( ۆ0Bg(0(KSٛE]fn6Ske*AX6 a4ă!PI#8x՞F)WC)]$a_jmcx- M&͈M'qpc )6XcЖ) \iP;A X|b'\E ۊr$X%WY`+$;]OX%=Pb_>)O_T> 9nJWęInJkzk8$a気#!bV DEk3hĚoA&i֏üv: *`of3roUdRfNSiϤD}W}U  EOZ53X1m):!x· ␰気Fb5\xD Z&NKcdQ>.qcjl)_YCq=I?<Ju{ węE}oB3TvMƴࣘ Ԭs[H)NoUnJ9oš*jDu_hXc>8Pv4b5MA^jp[HȆpHȋH=ḯ J. B?ԎMS(`y(+s\fQN)刄J":5mvqܷngJT%;ţXCB.$Ǵ4G t] L ;fHnT- (+%! sĴe)I g'mǥ~SßqptG7p6eMyPj5^#q|LH%[Cb딆j 6 ql88P(^9)ae^nW4pCkH'2.pZf&eF|:a;)QhT cnW0 w$D8|Vݘ6T{T$l0G- qPtR*o -@k>6Qdrد9nC77![|}jxwg4!daxȔxD&VGr f2T:rgqBrY|&CBN$(8wC%ǚ2}P,Xucl%unŸ"95ǡ r2^!bvxwBOHJ5t3g`hQǃ:gMڷf5aDQ ޖ i!mT 㮇bϒ k*Qֆ%89:`TaZqJi rkhܚ6- sVNXOJCrxeҘwQ9_=W ՓIA- Z=KHǍKБcWՁ/:!֨S$1 )`zALA?TP%` !`a%j\\c>)1"Ӆ;H`[3>4GSqN T] *%Iqt4>]Q[g#fGղU26) p$$ |0\{ zs_ɆWIݡp( q!vԍT5'ċ9N&NyN)wiq:Cup: OA݉߸2)GũIx .IB BUb'a"WTGyZLv0Е i5iDWyx΂j^% TFA .gCƺQ@ (FcW2PWG+H\5GNJJ! ޣ*̕ly&:R 9yenX1k&G5OgxP*Séng4asLi1w҉R3q۪e 즘]/~l@8$Br_BMzāg;5[BaB2r[ܘZ36[AAY  `tZރP, " εZ 4LH'8E9P)=#Va, Z`alnJPbVL챴9yv#KU_B%[B"W=l08u^.5cXƶkZ] "]Y )Q[*/ēoY 1G8"DƖdqN0ȋ]8EWuY% A P@ϋm]0U jOnÓ211 H0Y D `=7磔MHF27j翝c>8Cxh0VR񃀺[M8my;aZ^P񫬩_$b>=z6vʝyXhc S$!>Lb]Z5 |O KbEa$aUê4;x%AvރPrW$ V+l*IVsaqLKHqW9Mi) i9Ζ 2/UhSnd'"7r)+P`|ZЦLKHlj-S気Ր\Err) Eˆ9bõo 5IyדQC195G}Qi0)5Bk@2fQ$Ck-knsv_lVUPC:0G,%_ R[ڥ 氋_=ɾ L!>\Ҏ+ &jc<(o smZ$̑~K{yP.\2|x\ط#9NI ;rr 氋_qޥ*:3:Bq\Kf ~/-1(Z4~Q(^ ȷblZ@ cm^ 4T>ADD >bU*f- E6[ÁjiPG!d"g)Z?ى"ck q(n5bDi7۵YCMh 95ǡIq^j)7_FsldL9 R`|ᦰ0&+nĐ>JQhܕ }81QѩaX1}rtIXCbIl]wj&LbJ߬m-6Ǚ#)&TUxğ9iixBF8 ͘dF_q p0QMF!R%a )mT'C気gUy#d-RYG6 @80ƃ` rTflcle y sy[#*kI9OVN1q&n AJH, CWA>. 9 s>K5nčКM*asLYݜfN`<ߔn iX'l][ sKkx#Zx@RFNF[Ghzc+28bZ-nг[) n]HA8~[|;UZlOhesnu(*`j!ğ95GG!ޅF )}N%9O-V@U+0 7H9~[b&aBR 7Cz-QI+/xvH9G-8=P<=+OqJB e` >#6!I'#(XWA-ѭxWA=W򄂑%$`> &eej8%!\fVr\777T̢#樇*?KCbNϭAӆ0EG-H=.:gaI)˷';TN8;YcͿݓ4jXJ| Nvb5evs>50#X7){D' Z?LIg[1m@NI1b9oixCÛф|` RP8+&h `] ^Ymf{߲k=0=~y9ޔ FHw(cD[B=E!1m)'zl ' b$ qgvR>S7Ēwյ#r<8$!񑵾E)a2pvv( h tLI`= /5 Q?@gZWt:r#wTBaR0Pk F~G( F=frFo)8-NG:ĆϺ5$ b_F:lڨ.I^^Z{J)剽ODhBX E q-&`ƊrؔU鴬)7 gXQeA@ɫ?8jU,4$nʅTjKykur0Gz) ơ<*[5钢 (v Tg&DfJ iXB: G=~e$z"Y3^$!qewE. l'a'5 Tb&2DcD;J 2W(Jy숛`Lϝb i8Ne`1c0G- qd!a{MFNTs)De kDPӛ/Z68yTgDc^/J$_Yk$ #J$i *xA3wG}'9:2$ڇc6~eJ,,28x_m3bwy(xV%EDZ\%8ǖY/0nE#6-}0G_Pu20ؔ=˵P^\0]&}T[֘C )+`KAk!! Ÿϟ]x*ĺm"펚<ċCXTйO S6ѳFiP~@? W8κI9 8L{,+Y{pSҐ?)06搓V߁ Dw)A5ޠ_[v ;+yōi@4RPp+@w0G:- A(QݡNg-`PQ|hw%0 VPؤVI=1&C'̑>JßQX&B`[,NE]`WG]~ b2 I.[k|gLGTn BkVjBhǥIxo@M7<45![|T3A+x|#pSI(`v%!|-K֮Nq4=R H \#!.f6[vb|eoqHNFAixA(҂ =q|RbR`Lڎ7RCM ևⰗ7nn| Dndl),§6nW7G4FHuc Q=a0O%g\RvBbq6B 9a5,$Ɗ8/Nx*RfS5S8 sKkxJ l:/{\lJPmvq0u$D9-! kP*mM???G}Ɖ=vrsw"]=-',_*@PH ! A`M)\(?89~ )c'[BI֩@p $)!5 Q-! A(Fv0Pf ?(˜m" :0G aq#3S*[AEYD\v!zKe독&7覆}ɦkb\/`pjH\U3)E1.087X:nSℍzh4Ha/HcPxk0 Hp"v F0G- qhBK5tOxݱ2.b)9"?4ӆBkHJ." Ɓ0G- q0`EΰxR\ !?C5@ܔ) kV ޣvGA9S)1hhPkq>- ɓT`L`ھ5D-myCP8*~&ʅ-m:4.|Ly>؃z+0.t)>ᔄL.t>!(42VQ>DaFQ,,ᢒ1UL9$6tRq (616I#8L(wU:í#NOW #7昖c S_ra]ژ5+ZBjYu4| >Տ^5ǹeГ%d45WR&ҬH6?95ǑՍ3XrNGզwpk Xޘj>xtILl : ?n]!氓*i%SB)W0ۢDI#Vk& kH\cG & blIvR ޣP-VhubIăr! 5fŭU@7ӥ.bpqv0}(O֝~r!-ZP$@ƥt)(5) s]S⴮ekJeml NqSZaYk:{H"z#Ll`xJc4OTcTQg ᦔPm~気G` %n\CPoTV‰T$ݘdA`LJ&F i8ߘ6L/a/=fXkIRX9r{leN" GTekHLD(n qE! c|qYF5}rGFuPxof}p\n RFF~ s*AUH$;t#B%1Nu"q~WTWPג7B~=]lbGfsD 6.jtS:aٶAsm:ahQ[cO\,&JDK,ƿ&?U#iCio UA^^Z{Y{84t=|[eIaq #V`X}, ,BQtAAKaAaIXp~N IpٶcCZCIV0Y'mF~B(`\<ݔm1&?? sT*]r6$nb1C=A<.#v%)*],G+Pug;hb̈́hX;O &*N/Z+bߵ䈸AX&t Jt(!6??Erk+x B -U'bZݰ!wZqK7zp X^/%Πm[v0C,!(Ѓ*}PXʍ J,!t`NR%a 16js08nn0\dI]f,ŔOu0CzsLKH1mh;N#eQ1fX buSBW:N[͝SUU}w*JlT콶Ĵٔ早٢,#)f>pEɿ[9fM)Xۢ^|2t,ƺIai*mkJ=%Ҁ0 _)x 8=\Z((Q "՝M&VM~怃8{t ݄kpj,Xؠ>"es(DًBM#}{KGڇz.9{=HlT-&)=_(Qrk̭aûWćbdsBwä21気gڵlzdrf[+qQ^c qk ƴfDUfՉKYI.08PKįƈAſCL@K@Ae- !9k)x#(i_n Y[!^ Eq'`aw~')ڦt X]C@ P CPbaq0<ѐMBKeh4˪'!AvB)x^ ~҅䐋1v}dҤ0=0ɂDT(?Z G)~pLIXCbyCѶ aăH25Ǒ}t'%ʊ-y:Ot5gS.[CmC^$8kH)_I_PR 'rZaQ:}S R`L 0Bmgrvd" u5JO k{WΡn-㸦'V"%66/!J54j6(/đ^JßqԞɩDNM4n&H{h_dqm*0ORURAdmIMHO!{s) TY̊ةlgX 8%a W5eeT/AcZ׿ڶjarru< Cz(-yFןgQ" \m'qj 1 #;lCH4좰g󳍛Ypą(E-7B.H~~N e*NlF2:;CD3FY4,'q,$= yiaH>Ȓ\E1㦅?п ;| S!(m:^#EہȑA`9j:03 Y1ubL1G+NFwLxş@z,ˀiz>i@ǀ` ,{H`Mts& Ryl륁BfP1% T WʸȬT?SџL&$9:5$`>!Nĵ% Ea Gi udYQ0Tb5t3Ph5i!ѭ! ia16p@2% $-V;l&Dww#TH?D'NI_l>"% S1:CAX1{P~ [HNTQ< s*2$zsLTTiBEA[*Ea Gi u@ P71kmV^;~iLFW7ȑҰ􁍰9}ω,!([[V e#2|Yx_OM[t[0, KA:4%-WZl_[9ɸQXS7f$bR3(p {I/κGHT(}_; lnũ8]`dTUR"?n %1`}t3q@X CXCZ+1,;'3~pEEE /~jP'e D.KW椫cONdgohQk$+g.0]TXpy.Hc@F-U(_㏃9B 瞀cm8c Ɲ4R1`(NJ>=F1Ĕ_K%9#6j'h r돲F! Jـ<ٜi ~=bc*rL;aN~yFI- [-[ҴАр%2nYxێ;sJ/F)1. ~H+: Z>B#9ҐCn?x#[} nf@0v8)uRlZ(P1tU-9EpZ ,m Gk/)M(Gf,Xp B]8E (83֠q HS$K FR{,T5MG&íhE-y}ņ"sj9.ha<8#Qa EY7έObwGwۈ"+͒`N[Ui K{fL+@PhQYp0kG&-Cc3iH|߶k>,$]ϙ\cJ>H@QXQ{|p44aFEExIG_ϟGvboDn>&9HLkȂi89w \R R2^VDxtEhhn i"9ŷE- J%7)QaAkXlܺ+>Js(i:xY0$9(,Cpc[=it#0(t $]8bN'HM Tvbc*[pP>8\q\lI |Xyp! >zw˝D- uƣ6^Ř6"cm ZPRxZ\˜ (0% 8Ԏxcg TJ{ % "tlB ԼFаD4 bp*(Up^If"#/Tաa;ix4@`.Yˁi<|@l4]ܜ`W"sj 4kP]:=k,K7C8 ,rGu:P~:Jɒu$z0]ꝅ^KP'~Acstip-KԮK4 R>?S[:ӥ5$ᨳ ,pQrޜō)A8a ~JR>I9<VoCaI)dx/јFHN4ȜvMzIw{H,_.B{s8s,`jq:'}^_6xy8e 6KpmvI#bqI0~M^T۔j4zcg XF*jc3*)NI!P8Lw+}p!ߨ!=$1Sn &&9ŜWڄ7>;nD&)!*H ÀiN@<=k`vtp<`aө99.!qQIGr[^oΔ L!@Lh`Gh5G2w̮'U_ZUj- nh2u$*Fռq8i!أ>DH Gi uh Ud= G Mv~Lr#Ѥa TB}ֵ64,q{dGnF5>vo QkH:T,{8 7&,2KatuuRrmBifb+d7|p#;̘S{l$X 8LӅT.,2jx{1aq_r6`"78Z 6% q,iXb#s,$-Իù!  ]>H Gi uhc;$ Ub仧GW4:C4vVK& [H>Ar^´O 4, mͨX.tUukØnDu,396eaX9}F:t prȂ5$4@Ӹ9-@DJ >IzD!DF pK/(A]?mPڞ~OHْ˱x·H"*K8Fx}"Nz2V(q)$9ނ5ҲШTKQij oR@9"񁘜ZӽQAZFf ǂi@g86ebHAՊtk899^uy~"E78Z?2?7+4'ѨL{0oΞȠeڳ3nD<>{"Entut"DҰlDLKqQXQ{̔䖥/SD>521h; LȞnA}1кf\C9Kdв^5.UmțǶދ_ǽUxV(%I`>BÜw ĀpA:$2H SA%gKo tnՏ,re LݤdSS4GF8\ IݳM m݆|Yjt#l $24]n\* [.H",e*ރ8e2918Q$GٌoC$Dr $]I />HXAX1Ut'J*K&V'{bq3dz<+DҰ 7Ӥa i.a Gi ueUcor?zt! }qxkJa[*0mxڈ$o*v88j nX6cL]9@ݦn\ G]|X`7vlt|éhx8d 1X1{L26R>eC*UQ$8XHd)֐O2vyFa Gi ueMJs3 vՒ<n)@USM̉(jxDbH Řޫqݺ8 lE/K|k$1D}Y3-5>4ˆH8J[xCܓEe_ -NEu==d4]|~JCd;}^M ՇlRN(w_=il)arF]4ΌnhWvф~D) UWVPÙs_0Oԩ[\@ސƕͻ/K kȂi@"Ne42q֐:T>tY<@_D˻ OR@U/s ǘԏfp@ $ZDvY=9byʏOh}ԐۂiN,As:jB8쭒38Gokt{<,1a I)FL% I i Ugpx݋aZ鱫Ҭ{¼JJTiBETDXB,z; K8J[~!!49]uZ05YI8 X 6 Z.>? vI| 5K-g@VaLT޵uRu>X5qWVڦi>Rc.XBY?!yl<ߦ&g-3Ϣ4!}a4}@ѥ@C>DH[בn>)XWNjI.Q}?$5d_S0%XSSDa Gi u'J|y8lCtyE G۴Nڀo/\o:#!{ b[,&>8xdXj͒wIVpKT*X_$`_+H>ON4g \`}m<(Өs cQ}G l@ҕɘR~<铪;}?33oZk|IbJLͪ~p! ҟ%2nYx-VIY֐Pq-Ri笳>s8 'pq@9-E` G(%(:DS+Z+_C`J.GC9 <-^zSo6 M :r6<-\a i[RCsL` hU070oINpMPCmVUm Y0=~th8K8H[x90t5b !μ-ΏglϡУלn1YQVǎxG=8ΜH'*~NyҰ˙ñFiTJ,בWEWEكrUدqm ;L\x٦nѻGp: Kdܲ^7qd9]8 {JJEDiJ'yMVLWa"q[/jLLdhO&&j8p8%J]X/P["[%4l!ilIol7i1v%- Xh#`FVـi8 ’\FE1X1{RYf IѠh87(bmeY0] y8Ұk=h3eI9\)O-ލFU|l$p5QG@f4(R* ((I Vrk@H3x Gݘ$A60Z+ $FZ'۞ԿW@O`Gg~#{;MND7lLyƙ0 Dh Il #4)) %@ 8*}^.ڧQ'Z/]5nM㍪O%!e"ih٣?3m&4xB QB:lH|i<*F5KZ $) @utr0XҰҡQXpUTƑ hJ^KotcCbgIՄ5h!BÙ֐{K>wR?|_[CJrxn~ q/~ HDa h!i@c!WqiQZ,סKgfYU=82b-nPy#ڂZֵzZqMci Yc߁Ap/74wP$5dtz89q/ ?.>wV/B)Cc0) 82esh%i\XC] /.7 #֬.WGbXCPIMp5 DWII8 vVZ8+96e!f#?\ N !Zۭ->={~qgCl -b?]C"a!i6ƴIωKc"dJp83t٢xREwhxH%[zh$KDkPA)H\5&QKMsEDT4}T?|'[?yJdU*{bviLr;cY5)uy`.iH"0IÐտP؛8Kd %D=ѮD|N׼)RL"./^%-e7 Z[OΡ3{12:?^e+)Nc# >A98mĀ:],ѥa =APS>HX) Kdܲ^7PXAd>8?6qRcJ$Eǟ%Zm!NNMY q%-Ve$t%fNk{y_l] s`i0L.)w. tdɧ?(˿!g -}2]P3oVXEp?*(x 4t}VSEa ) U 3pRhO 9gA{ ) cIbXLpM@eC\ 5$m eXhY {8zEU|6L$4l!inej֋}|V#3$QŸu~ ?h@GVkck<=i`o@U[əs2l`l jkAp^;%\ϡĆ.Q,6$#u?%OH%.q R!{ Bi\L&S@bxh_Ť#tXrZ ;f<|qQXQ{<,Fմg}fƎCO:5$ݐd DG_B}! {O=(R Fl:fUuhh< ͗ǂi9֐Qt">SG 5F9XtޣU *d[ƒ>Im wⵛ0(XXҰҨSp^T}7ҀAs9gMYJ- [غ|<N,=Gm8,!oR#l|MX}vAS{U6hw8Vgy?,mU.U]v]0j{馦rt]5(RSZH>!N| i=Y" IV뇺@mCW8b jfAרq5/YbXCLGhSmSG=|(,(m3f(Ti[rQ|niLyib<ֿ}II~N# Y\u"_̿~鉿n{|5$ lLkY\q]WHK!X!c,w@@rX8⠍lgvmI}+ PTB1Swϙz-GAGmUD"VKV[{Sx/ШlHw!@U\vР j| W_YC@3٢_/67k"@z,h->. [ х%~:T]Ku!ᗾyW/x8lJҸb$EP[HfZr|G 7-YR9qߗ ^ ^!߇x{<$OOU9l7G?H ދP`2ywLjzE97l3FL@/gWC07gڦ,R{ n,rACj Nn2im}0/ҝ|rd i0 IdgBk9߁9YzPukFX0M'7ֿca.@p[1 QcaKq北'D"S*9$S1sK4OL]+xdw]FvUȨe Mʘ,&iWTϚmwҪ} $4l!g2l Z= K`TM7^ےL`|SNbۂi9֐ேҡ(,q{|OOjrވsi ވjt֐ q5d(ߋ<]L4Jؖ{ٟ a!+ I_MNYQ9ɭ$"}i$+ Gi uhC|/?`4EV0 ϡDﵓƎ)苔lscM} 3KӪĀq"48?ǨcL4#PXZ0MQ7p(F/,1[xC7lbrꦎ ̲DLR[۹] 6`fp.It!2C dWP`!o]./ɋA[u槂$x)L06m  Q4,1{ zʑK c{( 79cL7[K 4fN-\4۪R_UTBߴON`f?tSH!g.c2 L~$ WGRnr9(XV(D3{qn! 5c'-s ))As?PҪ,Yj6BWWjy-xLgs ,a<ۭ?vXV΃qI̤^;71W SCd]@Am?!it sl mp6!C8#FzXHȜJ&q; **`  NQ}p:ga3fb:Ҹ$PA=X?I~sK88[x/ǘe"Ic21_4ʪ/VZbM>l4\{N 4p1˅P) k6=ϜV=>:yKcv K3d4]&N\PG]ItT) d2g~˷X|87~YƵ0zIC=ڱpTtiBQXQŸuW:mVt[@}8 )$RBQ=L7n=-4l1X1{*ܮ5ue۬ {=ȋ?%GMH7tUor.dBt!Q4(RBAkлjB(7'TrשhtVKVO01!@8Bqӟ??tOiTUbN/:{PDws @ mc ؾKA'j `uo{ T2vpB{k@ΤD&6 !򃘌_W[=ʒa31Pa9 A,Y/6kD)no9~oRDcɝ $VY]20Q@ !shS{3:=81C&BZף!I".AIjGͱI(I>%2jYxɀ3_L&oA8u=7Ѡ,1;bHڃi4N"z/A(K ssZPm@5/!hIGK0j !C{ 'gb&Mm# *pcIOhӬ! l =>H~Np^Gbu͔:9% 3rvw!iauz$rc!ȇ&c!N"g <{/WNͽNofKGF+f4Y:cL@tL ]OaZޫSӄα|sU%T:XlU[bZCH*րO3Q m uks|/z=8$H ,K#_! ]T4_w~JQ 0 uɹ=cn ſ&H]" >3gs%-]5rij_Oe=iW=$Q6ղ4}@CaK',YoIeǃsp&j#6ʯIR%'hҰq͉O&zjkva@RޫV-8'G=ڻp41<$F }lM ]r1X1{4yc28&H l-'Wf"WI(Ѹ!P8튧HOPs t{ ȟ2 d2Z792#QŽ4RAя*n 4Lo*n5bY%U:J%WvF+:q Hn_HtCW]"%'PMB %(UՁ(u6"^[#a~U5KDZy0Mj.*)-|w'C%0usXLsb_"Q:^^ ̱K`Xh-x}(,q{'C MS#4Vs⟰idUNxG3P}H,i؂i9֐k]>Hc! Kdܲ^4smВm>ޢHܩGV{rJqjm!:4D 8jx>F؈tDĔ 5 ؜zD:s0bB.I_*43h(mP1X!k /*nxNbܬ>D 8xHIY0MG`iiA`i4 ^|Z9c[@%Ʃ%c|, SA:4%2nYxCo71U"8ΎJ귛yҰǓmSy<|($QŸuˈ8N5=c0K8t%ni؂yBХaQX"㖅:TtR0 ԾF廪.Ӊ*w/iX(! I/ q>H㯡($q⦅?`{4#A~'c2~tr}{ I.VI*9[42ѡЭ GmUhZ,vH`mVƜ\nךX?aN kM`4c4D- udq>p6,qL9xҢ̏. ÛY0MJ/37{FlO>Hg< W!\[>;%P#?\nL8aԇyp TmK>uD- uQu1/gjė~N*R MT',!{ |C(eLUV)Q4^9ҐDTec$=@^ K=&ҸVȠ{\XO.amupG"/RCQUL_E@i!mАѡ(RZCs9Fl<+76NX )x$cKw$4d I$7NF{h+~v㚐H) 4alxr+ՠlMLe Y0MP%'.+Q#, Ȇ|d)({;4&9rN/Z@H|?="" %j.첁{a 9q SE . emJSn yՊALjbΙ%Nm $k'[wZ6 LũȒ8ŸRq*7ь' (J5ŵHDz`%ppd9.ii%2nYx߿.YMx)n>Qe˫(!M* bMσs1.:|rn.- _epS/?tL}_/Kv~y|]I7r8#Y.;-3K8D[x/B͛os 6qM+_3M=KҰ#4)QK vA:% Wo|6:3p~7:6=83'(E[HȜٍD ʑ|(GЕNi~_~ծU q#Mlr(9ĤId>g}v%TE&B lǑ=Hs?"KR59Bև8̶-SBwZb1Gh'^ c8 )S&Gb5/SmS 1G1JcFa Gi uXJ8p>8M3>-ac0Hq%K&Ps`mE4ʂ%2jYxΙ51fg289o:?z!. iXbnB h[(ҰhRp^)s%p!%91̛U]{ޞs{zbE $Yך%PX4%-W*_uU&ok\doNmV1I.z,Ww1p@4^cؙjmMKgq!p"?p03*IXJGBӂhPZhȇOF,!ܦUTYwoPI7blnIiZʱ`>t=HAZMw{Hdܲ^f)E')H0Ԙn(N%`Ox`T@]FAAX1s *P=ȜARDeDi,x LQT7-44H' d2^`W#u@iœ(-9 e {Y7]l4]&6:lHH~N p6^dm;@gh:/tޝ5BFNi Y0 Bca(,(m,T:R--D)+W+C/*- ۔QXa??' I8Hx/BIU}p8&ҏM%eu ?Uv $ÀID̈G{؟'F2K8Bx/A.nM5# oC(nk/bI7f ,L`,;\] ,W $$Ka/&'Қ& >hI 2g*\DKf͹ _ZSE3ICbKJ5ƃF p6^:яd|a(o_ }x؀[KlkȂifYp4R.H}nI8Hx-%Xt3nt̨ tXұ9gnJ"K},$M03Zds"$("|ʌ]s 64N0軺0!p[~ $]K49{RB!Zf+v畜şGA=WCʟwg&.+ez̜a Y,c@(VᶑK]3Q`v ,3$gKpg*= b8QByKs34;m<s<[bI1'n#c y,C{BINki nmcXCSӶ`>>?bA:4%-סmbQP͜ވ4vvwĿ0 CYT7-(JQ% y5?$ěwgh{pnExlE:2+}Ƿ?$vWÄ,$]!9i<Y~_c{n8>7@zN ܄.=it-%{eB?1Pcs t)i)KS Ud.1RQdJc#9o躘|!17O4\(D}iᒆ}V&QXBAk|p,1qK7bh}4aa s(bD?>DڈQD- uXhJl2'LMSSh56WkHb,5l4}@CN<z|VMV Gi up[_1=bnԀwo@&m Y0M~ƿcK.zNp2^F&g` Gna>l2D*l9I&>%oSk'4-Y`:O?{SiQ46T—qb I>a@a280z:0 HLk{. 87Q3Tr "@V.E'/%==`z+t8j[XҰ%% ,%P 6(F<戫S4%T(H)%%RRk 4?Ϡ^ڠ ǒnn({V6m3װ$~"s#%uOwI:s=1w}pWgoF5/WlyjQr*qPHN r`:4BJi"x^.yi0'nZTo 8?DiqS@ܤnB??hkcGW/#>sR&!{) =ͥDnx^0"H.p`6Gqv!f*@Fޫ? vEsrxH}]:öKh(`>!XX5>HQXQ{WBU) ̉R MNy֐DG ڱ z{>|O(+1G'}FH m up'l3SQ3 ,}L$Rwm!cOhVtT^ωޫ~'$FcWoF)s3*Ab7=ijAqLc]~{*x٢sH9֙FJ0B6n/cSbkBҗuٸIyCt!V?Hpب(_MéI ~KY,}O؝zp8Ȧ-[bRU됎5-ѭ! E,r/|iCQ{~%sfK {J\J.`Řtt G~DE~vc4Ɖ,@}BN!/5y&f Z"jL)G\*:!X!{6tyr p r5 %^WЬ@5aHM"lUbO.D# bwK8j[xB߅е5p8!@i63p$FV[SWzXwb@(V!XNi1 + NA#l9obzrG*$L Xjh>D#a$%2nYx#.2f. pQEA.'- R"+P* IӇ.깔O LJha\6,=5>/'m^qkI '#Qv,$}d"9CЁ'p| G!RgF}2 G4/f-1! gXCOw>|(,(mmy-,IJ&`y 8x( 8Ķ, \'38:- 7%FkY;JEs:kD]׬ɳ%5d4}9UA֠DF) ֡d{mZ[rq|t\DcXHv{M@,Ь ГSa ܸ xYAޫ`"xNJNsi1*ʅLyZkPBO䴐4}|~[ > QXQ{ͩ,r9昱/Lt9VN9H ` YDp`l!,'OK_*YI)l|>ﾎHkEsDj+i=eZyܰiMH.y*}! BF{497wQcZ HhS_b-CpY@ }n.:#q{2%ZMS[L4Ie)0YDWS'Y̘ϐBJ8hu;A7oE:،(H*woK[V7]St86I2p١$2jYx_yqxgF*𔢸S(zM4Q VKd3Aqz89sh`8^4zCofM碭o.{?K$I6  OFԿ_NIqSp^lgQo7y-ש- wHh I8J[xC奍#qɶY^*N] B :M~xC`pGd}t!6޸L:JH~~Np6^ ޶hQ(1R575»nθ\!Q0&8-$݌ԙr;! BoqLk^SFb4N֐Dmu# 8&Sv@ A,wϗI8D[x/0ݒ Ѵ_ N:qi֐Dw,@] , e M`ű`ubĹ/vѣSnsJK`.Y5*/*.4r ,Vq=Puǜh^YkQq'}=Dϑb+jBAGNȸemQW}AT=_Mo{$b~X]KdGg: =CDS<Z?ƅ [.B'HZ^H\SwnW "DsPp!Ct-jH"~a4}|~gXҰP :G\BNT۱bdx(R&$Qł#P \﵅HLA.D"U$5 YW6Pw0DL63ţȗT;Dwpx$6ߤ-VűХa-V%2nYxC`L~Mm'GC vdoTMű7b48=ծd4+"&7GH響{$iѤ!cɱMYD oEa[X-ˆQgNKP[㿽x )X"еÀiU9) 3)GQxaZޫU&'38\;98 D+mĒ-n*l8v)Ǔ%2jYx/ y}p,{_su[ۨ.F zp*nl/iG7HZޫcⴁ/,9O9q=xԺIq'vՅ ~;'9X{ 9 TsT#~nc[!.0SnqÊmP\bo%)uHZxl#}iw<JwS͏O=zs2s2FI"I' d2>{L^>RؾduT7pChGE 7mUrtǣdཀf|w%vr|T(.X11%6 0ӰcI>02 K8J[xC^|p9.~̠44 a  IWuw"i1]nQH"?#6GqOͮAqqP3iWDFh6)i,%-VV4;[ ĉBCL<*& EyD5wGbJLӇ ȩ ^iu@,ס[[C/zP7vp5q@HҰۇc Y(N%2nYxCq;9󂖌um=v$yIK*.k X~3CMؤf]"zƆmKVfd\6.љZY%3Nw bl'STsH`0KMұuZ.=вaYDꭦ"wM8|IQ%$1Yp,nƉ`v ׳*k |ܺ H%: P޹F(>edEe)5alfl˓b2$pS! ^ZG^ SJKCVw- TuL|#?밈@! DtK0L_%Tu֑p<&\}Ϙ ѦwYk=M8^5Em:Z (A 8GH NQ`X6BzA6,llC&wLUj#Bfeep 0(TPX. k.Gtش/Q`KPSE` *" obeEM6eqXŅM7l9H栀`҃@@s_#L&\(»ƔW17O8$C}JE VA0(8XGbFLq^qQwgfOr`xpYc;7O)af!88dERʔp>D^E#ftkjY>3\_hbC k`*t?k'qd)l%\FZt>V8%Y*sj8<)S03g54&4Y!(e:lXIز"(F˴R6>bT!;% w&O}?a<gn7,1Q_WV=&MB v1X@cnta .aJ66ZurYaSKL觍;&=D:% P`G9$L)$QV@uFdj WA0Yq[ch`H0aZ }ꔘ2%G@]G:p9\&}>cPdmEcm͞Z wLa0Z0 p76Ƞ3hQcR܂!!\v^\s1E /8K#&}@05 KnQGޭ5i' "ذ& SqKL)`@ [ 俎A-3[%fEJW1vDZQQe:Da5(#6Y3w%W5@L=~Ȉ8bR*1LY#X؃ Añ➵7,K0L1$ırA:q"햄8i=$x!D1 S 50ZtvMH%:\^8 XAċnߏ l%d 0Lǭc{&kD_Ǡk+Gω {0.dp0d2wSXtw%0r9^ZVE'fB/JXq֡d:uտU.M'l\#oͼ- i$\mu'ĴG%$G|u<3(%,a ŠÇp4/8CҊS9p,s&0a*@ 0}vX4SDKBպ&\AlȮgJg6IǓ{3C# XYa [i qdxg!1˅h;0r `3R9gm[LZ[/j |d~N~ds)8LBUR0<"K 1 R 0<H-aTcG14ֺ`\NcOQ^3$v X-դB0BSu,Q^'3eCA`Bt0yb5M:Qe(hTA0e#6uqJb,:o/x>aYI}2' r@1Y)0U W1H`OiCRpQ/ 0k(X1IߥKN;Ŵp{a UJLe̔02uA88l)l%\+ā̂J'LdE.#_S|76/|)PQd^>|b$*򒻎Li$\ǑPDl=0;B~۾ӥɲݗEc' 7wLjIXtutO}f=3 lw̄EƳ9oI`5nt*En'TS>Ix595#gOC}a7VI Zr$E[j#d C ~p@&BvTHZ.wLKu@1+{>YvE٦pw¥(7,BOdaxq?:ń]`_Sit>niERnK#`SM} `\Q S(bw2PcF Ď3bK4TW3~SD(nҮA]-azⰄ׏2W%L\0LA(a3fͲziX 0E<'KV bj")w 2@>_GVa8VG `x6+[Zvٜ&qbJ Ȧ="|lтpbN*PK)D-TidJ`Ɲ090<<`:pa.!'qd~fBE[CvL'kayȟΟ'89ݘbDn郖])lٯ#{mP5Rak;m O3Ox;Ez-!aCL̈]  v+10mql4Ѝ+Y` pz` wumô'F6Ke*0OzYyA GfMK).d:1J^<9a8AGb%$sHB=YN:n)l%\ǡ)v3"bZQcf8Tfh9ǜQT#bk 80vyY_|>a™m|PQgLP{qka)0U6J URAi\Gڰ8+<0zGDlEĚ06&Ÿf S8Y! 1ts'W#P k+A?0l "<׍K˻`7 ETCX%UT D`-: ̳cV4 yFau))XKHxPs8&qXa SJKCG('̄BKX8%TXjh2v%8}B) gL0M NZ#+CO}["/ĺ<^b&+kD&iwViF}:fz=I:%)l%\׷.hi_FNGܔ >γD_ ,K@^s, (N+Qpr{7&'-Ԓ ##]+mup'Í%:ZǣIcп eYZfbW8%s`Q)1ᠬ bBLL' 謦 I )n(F x5 '4h;f͉0F3FaKPA&I@#{!'EYI66Q1UMqNθw˄X+z!t `NPVA8l)l ",q=1>p6uxd%a9}DQa CNߪL8z:ܾ0E- q#31 kPix "5qf^=iE~-_%k %\wL4c"#Ζ^ e|VRL}5<W޲kǭ` h A3uNfE*_Y4m+ ,V(J0uCf * 8JG_V(*1ȿB-M11<5*Q0Eȝ,`=+ _WM 2^ПFt&4r`nj-z&X4[aj8n3U` ` +:)d/CZ(ҖZ,B8C\ g[ (7wO#j(¬5"$0u7FYŒn]aMt4VZu|5'BqBXIY᣹, }9ZqZ*v8-YtƬ H%:XtMp=0tGĶ@ 5WĊ}R@*sQE[=å+(2c6Q0e֪M$}SlԡO`l4((?tcpG.]ib^ M#lšܱTE:r P`xS%Pv k 0:4Y!)TYƇPkυ AW2)"$!a8nUJ@JKM#La#-2 uܸ쟸 68kvx"(^I*c%l`SDK8@4V=&3\&2L®=~M-nY@?1Vfb}ODa-:~fnSeDd-W1޹bQX^B$g@&&ZuZׯ%{ّ1Gm)l\ 7<.r֘V0^qS~~\I1 RqKLS[P6{W!^s&22QDL ьtP !Vy ?@SaPEAe}H0B`ZB>.Cd!`Q%BBSVB`?`61eJURm0m(R:rŕډٴ[PNi~V<|r'%,)vS«q(lRT ' ;Iw_lU-V9D)! O-2&ʄ"Lʨ\P(}P?$:dt$,S% O>DŽulBQDN|'$ 'b3 `?JZ6CP㲲)611m~-P6(&qHAjX0 6i$\GmNwkWMSI#Ll%KE`xNAbXKj;Iǔ[! YL~X.1G9@X8+LLص݆"ҊO(f ivBBN @`)f g0J7f[8 C6\ΊXa WvB,aNX SݒpGWy1q!p4e^q8Z]+:Cvu tZaxa[='L|[DS,_0;{R(Hs SvƈC0uiA+LW9;nXgψUs6%>x8Ȇ QBZ#! `T/9Y=eZS >6)(1E"'bN>Unzmx: b0h"u0l%0Z̍a~EZ̅;\S $@`]܈v fP ŵm)hIBganx+qΗaYX3#e_Aa穂p FB6:-,~,y¬}w܌9<:h$*E$&{);fVPWuj3L' h A) W|I _ WDw7cD"&u{CPgC-0-&~@V(ldH I `- .K` Ia-: 7v֭4-愈IT1a7v6L>JlI 廔CqK+VZurT]A}.g֓^m\'(/{:-{mr:4''LՋYiɘ0h ᖝ%7̹)B7[)bI@s{آ S({.,t5DuI38L1o ŗc-au>NsMvKu[ 9YYlcF(QK K`V /NPNI9i j Ǫ׎@3fey۸&6;pb'GJHxTc6Q! J!+VZuګN*YPL`,`VumAKtxp"1HtMY q&&TY&L;*~zgf&6,t"7&Ha0ۢ ŭt e7^$%(432 7U31<%:%jPE7@B'Gb&1pY i)l\Ћ̪+!轲pjS‡'*%㖘X. ^]фb/O6KE1ca;>6Q.bS2eCK%Dv.C E- >H'L^axx!\wi1>QK¨*S,*e v̊(]"XTF B ~ac4"KhR Y&_'\$<8y֘uRw X` tL!WZHUnY:f/3O;v8Q#(ʬ֒`:Tw8]Zja+DVJ«qd(m#(!ѶaycoKHx,{8åSpG25q5pZVLj%qX2{ƒ2ȾBet>niBRDKB; m6N*/ ͥ(l%\Ǒqn5['fQ:aʕP\!3z؀)%19$a\:n)l%\Ǒ(T $f73{zdPCr;.pq$[b%ºӰ㐧qUbO gZрaM~Cs"kKB!K:n)l%\ǡ4&gjϋ r'||̢hRN54rb>i@J3,:r?D]wW 3fH'^aS%W 9$At' fݒMƲz يݖpKp'|¬8mUaaPMHwvm$0uh LLIjҭ08Tmr:LLA^j&Zltk _tR ,0ui$bY Э08MWJƺONL'>XO(fsH`8nY' D:G1(l%\Ǒu1}&֙#m6W']`:!0- V!+Gi$\Fn+nZ VXo' ^pv&T6>w 6Oc<s[aF yzn݆v_n%چpk´U1cFUDD(qQgD'hӉ^Yy;۟ ukWCLmwF}xmm߶g[܊܇}_]K%nʔf*Bꖘ3UڣuPuAL ʘ l=QqFG̪uyg.{KFe\~qc)ԎsAZ'+<{[;q@;.,~)sy}ost^o\Qnǀq<}}#oC1߽oj?&;N߿aǛQ jM{R3߾>O/괏e{?zӧo/Bq|}ӏ/oh1)m_߾k4,&^a^{\? _ߔ5FdoHm ӝZU yq%6oP,Wéldv wݮpKɇcVm悔͈Q~n[F6v-Kh7%o07fk/zhOo:"b@Aai]_H=威o͵mޛm/bS?}?~|gg7X0n x9h/x)~.~۽>i鍄odFt4xĿW9nۧO?;{pJVKcq=ybhh9k_jCm |c<OfjጠyӁ{:FT^?>}:~zwpB|U.Bݮ'߄CziGBEDҿt߾.U$zc utpcH1{E&Ev]pMOߛdIM{7-QGumR[sؕm j4[ڇT\0M&~~~L01ޜ/>|ӗw`6yTHy-p< ~2=~\;39>-3OgK[|\=o>P2axD|v5WKw_QeM~{wz8Wh9 RJ.p=֘o=KNendstream endobj 512 0 obj << /Filter /FlateDecode /Length 66693 >> stream x|I,ISSx X‚R! #JT],m|w|Gn?_Wm}>:ߥ+ϯ=W?c)mFyyP{ G |~p?K/K?4$D$qH sKkx|ǯV}޿k[۔|'R^LYĴ$25Lٴ a/a/=_;}GW͔vg\Z9ex=%%AX6 !u~/5K!%80v.-1Zc۔^R-j/+#q ג^[Cb Sp, .Z= {ą܏~S/-}^Z/~=8,ox5Yu)m! `=kϖy-}9Yocs0^wu.uixbj(OCwYv׶o8'٧1%`L)%~0 ϸbGX@ N*0#Hi&3G+5 l}mi9sDYOxλƯ_*os 1MeJB ֳ|s;(_C:σncIW}hN<s,{.v>či L(6@P CkhR{1v.e#'/xCnqI ƴ R5 Q6CB^$L q'[?Xrx<(K*<;'HoKR1sm~*ܲx[C?abr5<ݴ&~S~~|#兯^#=8$!1l)]5w ␰気ҿ;^wWL<:o<5ާ`v7J#¸Rz.6G5FH$e͡h m10G- qj'f#}qs>ċe5=kqw|z΅ǓWR  `h pH2\b\|DlR\{u1at]?8r ƴ{ƔN۔|H=SL+fVt `Yo ףn}eNxeHBeXbn!J/̱_szu[${i)KSqkX<`aGx,מ7%`Lx2%a ܯ bebL)k.}_|MaZ/eq؝5cZBi`s ֛ⰓRE^hXV Ԥcq\~UT\92Y֐6 AJ\KWj 6eC (z%8^S5LSbs>quٸWu_n)0 2fS~xX `hQ_fm`EgJ1Xi"j}=FI) s"`L0pem0G- qku~^ϝ,ocrO%]kL10Aݔ+^rέX K _ep,chu` a#$L) 196C^^Z{ۺ{Bʊq7阺ҽCb8O%KxE( yFlh/_AYMux.oHX雂ZIWr[76Ka\M >| к> l2-|c ]*62xԼPi5YHo*Ht ޣC~]73.՟eݴw[10ɵ|d(4 SךT> B\ ~^l $`mۃ84iw'i樒ZmJAP%aX#Hr ^/V|Ub\GL.vߕ(vh7LESNB5 ғq39ɿKlyUl)2s TE-_.5iL\4oH ,ӢPM9,ÞA8'/ŘIu7OMò]0Uf-pcSZ\4C.Z{ \#Yσj!54c=jqtw gbׁOL83[g+h2h 8" H=O\xtb.){<20_^s>& !a iXCm lbV~\lB,= u<;⬩ 8vݏM54lउ3Cв{_;g'c]8U ƗqJW^IXS߾S{ sIkxbo] F|LRPz&%v^qHB#5jHL!(lS6cc^#_kP'X<)xX*%FX*H[ư Q.KEFyaR~OGRs!nƨQ=3؇{s|[cX ic!VpPad~y2Z!xuʕ:[DyuR+@D0%`0s>$\naqĀن0~c8 ޣ*9ib6|Lڵ&DǙxY9:%RCKMrjb'&CBN$(^o}l(ʦ\qؑ.׃n#ƣQXp-5$t%)'6 ! V%08Ac^${6axXM ,eM5% n {%=܆8 4'σ ̴. %g%au_5^:;)hqp!{HMW{0- 4URJL:Y>vthf~qE˿uݹTby {z2ǒ-pj l Ɨ2%a Mt0Uz!R~1Yˈp2c BVӼ5h"Tq6?L0Q׽[zϭAo 1 氋kppqEvK9bb  E|x/S`L!s԰ll  {a[{ˌ,![;֛`~ohF1j0G8s.SuJCDχ ␰気V"3z5[Smc^∫QҰqlxS46iC8lȋ䰗-cK%a0GMP۾ A|`XyOX1,_~71Grv ^c`b*K8c];b\'OsCw4.#o3ZAI  ;a,!hP<͍M945<() !FW4ǡ{gUGۛrc_ 䉠{0.ަ¸vXۍ㴡 jظh;)N`p.s x%sEGطXQ6ד[[C5}&WVD*GD*(v}S⛮ġ95Gq0s5lʍ|lb21&`vmrG5$*Iu5t۔ b]@`BK;+&%11ig<@o8h6aH i5m# N>Z{Oco1r23cޒ0Ǻj %e V%`Ęp sI)x﷛)H@zUIϳSנ8K ƴ)xn 6e8$)8YUzcNeEX5c݌c() i6qK)%ds=cm#^$8x@ϓnkߺq~2F8O c]47rQ:fDX YD@ߔHZwo](p8). r,0L Hqu{R 6Sԇ`Z=to+LšWԋUaxXXWCm 0&L X4:#M{氓ş]w'1 p⭸.O@n qza$"0ǰ4.7Q$mH8Qظ8G')S-8q@(N[FqéoKONx ~ Ac,6f(Q$c<99>8:X!-(x <[-*vpHZ= ٓ%O,RqTVfFy8GkXs " iHL!#pH6Dz!75>^좵1~Hx?Rpe[ 樓mk0 Hְ6qz(/̑~K{6g͠8g6lRI̬wPPnybJS?r M"_ =(fH))^s xٺ.|A¸5X"$OX'DM%`=1σ iEhf`LK[Y񙝳}n9/uYmS.6B< AYfbltɐVqBR6 dr$mD2G+xp~T*B6nAoa#Mrp̪F)0%vPTN\6I!A'^[{;k!v;7Es]]JW"d=K, ² QȿT a= ^ &GkJԘƼ +KD%P$*c225.b[CT6C^CNZkFϋ)xq]08s"/q]?,J佫o ,۴):!asuI^Z{͊g\I?Ja-Voe蒰c)I Ǎb%#80 lӺYp ba±#pK@ ay=D[ !-HKWcRIEY(^Y77g8Kʼn]4!rkj5 ^y٦LubsYƖq *'κp|'Nʐ5]% 5`(uV=meY,ڢeLXWTs|zPPZ! Xiv0k8IޔSyꡎ3\S" %a W$%ƅ~i蒰 ␰気jMUΡΦ%IFh7B.OY?,~~%Kܘ ʐ =0=ӶJFٚRP+KsvPAw4O[Cbڀ)z?ݱ'X#C^ZïqwUO D<(QQeĔ+ y%F/I#C1m@KH :m sqCMʭ%q„Ćӱ '@ (aAR۔l/̑~K{&׼b}k%=~RzÁ 3C8 kj\̇f׶m +n.a{MFQrp}qqKmpM0GcԐpF)gŇ k`x_أyP:VL^evb#5TY|䊲H|UƒЁFUJkqgQZ)I8?T-0͵/.H15GL9X+ l0>O%OcC ɶ)NF2b 9Cfwm ƧZ=(hf01ؓmiw6'#ǂgؘ:ԙseElcⰗߑا9D<(Qd; Czߢ5#S `|3uRy:5 iC"9ejxcO7e.q|]M0PGhX  ԥ)T0pm[ ⰏV8ˌbaϤL`ƭRfR](LmX;raTKHC,{gH/8h@R*6аxtxgRLQQ{sDv7j!q@Rdyo m,!{) |ԡ:VqHGgԎ+ސ:ŖK&BfR+#0(ZxY_{mJ3kƄ<*3ń&e6G5$PKPCTmc, ~Sïqlk@ƗֿI8.wD'QvS2) kH|%BR"V0$`Ĩ[#sI)xb?8]Df[f2D Ty5čiWQ eLatQ~ ?dʅÙ5)ig b|ϖR]ȔSY\^^Z{BUjg4vA$;"A %X4z6 3G+x l >q(\lQY;ZDâcFo qD+`L3ᐄm08zR>e-y4`|J`|vd7$"o8`#sTJҞ uϓ8GDF%O;1㴹wqID{S[CM V|N^Z{\EʸI {/D@dR[Q(8|(PcdHCĘsT f;M{A1lr'C?tJAbX7%*KeЫ{`(TdhxR8nQ;kp9㲄4ZHl`TjiP#zd)y%h' h7>bP{&%6>_I*k0A+sAQؤ&$3k#'n<_!b. iBan0i5Ds |m`= 2|2A|bGt' [n5q\*$qߜX1m@W{t YS `w+00eZ4ݶXc;h8yaʃ)qb{- ǽ$׃Rh qTA7G!(LϓJhwa7h6ců6n(=K2ݍ{cƮ$a/8w,^"}7e`Ci$W9%<wc )akWi8mS6q%/a/=G>˥Iq$tL@ (Ϣ>.qc@J(qzV0$a j85eU5TXXE_1)*_mebY5kXm8$95Fo\6ϓ6x0OxsSiǡ9$!rP\B  ġ; sIkxBE8 Ro'V#NsP=#i&bUAO5y>4$vܤxo C sKkxoRPܝ5=EgUsZ 0޺R14vM4zPdYCC[ |8]{sNY&e*lfx\4+{D%a g I$a( 6$ s#t~7+[rc,[fy)~8@/7fLʔ5LJ63気+ \,6 /Siy`tY CO҃%?c…Ħuq]A%ql3: bi~^Y4ZH*5aH*q&t)RR{\*N)8l! -*ƜW s(XƤb0e=/ QkK;Wyp IX`aH6hH=tic)a<VJ~y0 PARr*C>?_qRk{Y|V\ X85kS"k( sKkxYDk]?uN8Gj>8XXT<--^vq:*{fqPD0#朝T{f:sh,nLX}Pb!< a/#PHS*7%ܢ@P?ҐjbmK(5$L9iP*^6q+ sߗe.ʛxz5$`_>8'ҐP+夜lm1j( sKkxc?fT64)mNF܂+yShy3či L9bYYBvރke^jsӐc() c烣ϜA1m@bl ME@'Si"Ϯ sT)#>n4Vf?^.58qqj)ji }ۃdVkÇR0eMu&%%ֳX]k҉?R4Kۂ0+ e*5,&b7}87ӡM2t0%rNHgrH/1+m-_lOq/a5 QĄo :3ᰦ渕=%* k0n8")) ḏmQB5%X"fD\&pޘwMBPsKQj0 dD) 51 sKkxWh9ɦ$*z6ƨ62syrZȰo4$L4l08Լ}ţ!"'muw?Y֟OKܘ?_rJ-sևb#}{:m՝gSʁ7-Q/)* цAX6k  SC5CB6CB^$G- q(&KsY&K4z@"jEϻ-nL؞5g ma0[/a]nRHtE2 e#qf}I~p h&e@:a;)QhUnc? +%cicISQOqּ1mh54Ik{a["e(y ql _h sȻHڿ->f{S? K}n,c"-ٗ)̹ LQg qp*)0Jp!:MH{m Q6>J52%%jeT ¡\OŅXC}|0RƲڔK:!T6?_ErokxC* ?ɸi9,z Qb8 _+V`<\$)]б^IGh8 Ukv% 8[ #2fPT`L !whtx=,Đ|0}k 謀eX>:)q]s z$6 a Rhƪi0G- qpl`EIiH 1 Qk=8|@RbWߞ BQɁtAATR%&t=֨vvࡌ5jMIdO V`L 0}\SA-}0}k;1J(G`bbRbSEcwp1vcBf;~f|~}駦<⇝ZΩSACUmrch}(+"%q'jjupRlplA8C`h#Fo%,v|뜿N6ؽJb;E Q}Q=!`qRq~i)ۭdBI cxtMHFD7翝OԆc>8xh0V[M8|;aZ^PA촦zp$oF=cSNx|7s4KH1M)MUo&#f~~.-gVzlgᤰ4М,8Eh LP5S+0Ji4XGQ[ a=zj9587ƾVe+¢j-i i0j]):13m#␓VDFNjPmʍP, FL#[bENRBj8/Uڔi iMmec ీ(uSXEơH3rpX0Gl a')QVRp"i F0}(oW5js4I&ele8|H ıv[B|P;xqax8mv&%TCtQ>8 [Ʈ8&i i0[0ag#bV95υvsEkx8{S%URM!CO}U*mFUZ4~Q( SblZ@ ce 4TޟDJH ^b[W3f- E69[ÁZziPiGlB1R&(2[#k۝uB.1Жlj"[1m Iv54۔ܐ^^Z{suzAR!&&q39|0T H Q[Dpaj}C(FuGq XF7NL`jt#1Vޝ%a w&eHӰmt]- sKkxcn^lVN8Dz1UNmq AZ|mBU]nG?0@.# TAJyP"hH5BH82#ʒR$psGR$"iۨNH/a/8x ^?vFJ.g$ &ƸA,Aʬ`,M,!/"I~n±i"/~Kïqg1Seh ;) XU}c&bPLzVixP*'K6\4Σ? Qƚ9nIXCbi۔$I6# sKkxC/yFav&Hg>4b< Oq$ǻ|hH\:Xm!a{i q![|;1-FXt™ᖀw\KHÁ44qr`Z ޣx'?sq+%)7 5Vx`5x~ gk0 $lRMʯoˆVsb9Ŕ(͹8*Z`<-9ҹɟj i QUJ8ԞE&?_ sGkx'qh/SnhDjG`XO c󄔃!Yi&3R܁srݷ)- QrY.-qs5$LaNj8%aĸk)xQɭx('j,1i0zAAX6B")mC^$G- qg>Oyv7{Hߓ8.8^^ P+OqJB e` >86!J'#(׼uP5AqxU݃y,W)YMfC R?gR&KS2AJ ޣP`fܜ#cI}H9Ґ67kP}!|8oixYt6FmIJq+ΊrFS4jAXK| vbqev (I[(2cY( 651U0ccڀ)˲5 bJ sĪORDd5AÈꃣv%GTI.^Cg'HM'@O993Ff%QFHrp N FrGz) ơz0AnH =[{U,iX]C>KǃIYC^}r6(na!Ž:x]l)uEW1G*Aa/q._! ƴtw6]jb0G- q,Y<aRVx$E=.-%v~|VƄZژq)@zʳGOL9`ge˙MQ¸yuVWIU;<1)9ꖐavwfV1P)LHH`0P;HL #JTBaR0Pm FG( FfFw)0N$U:[́lں5$ bOH:qڨ.Q^^Z{]DP@ϓ2P>_Qlf|EAnD:.%76Ad+OESuiZGzW ե{ۨQG5ar\e qta|m -$mҋǣTMA[Iő9oFxX[Q!*:$%K CӆpHȋ䐗=h@ы aEXIw{pDݼx%aRH=?oT/F&`FUcuݟd/%Lo뷸1 DWօIˆqZ CȻ/"wσE0GGfGE\b̬QɔE_(qױMbv-~}.%Ϫ$tbƋ+ ENʃ[qQkM9,Al lQw2Gu2}ؔc͵V֌ܸ0]6|TP[֘C )+KȀ!! Ÿ/Ϗ]ϸ2nz #JxKFXQeй nJ-i S2*>~KZ#稳ag-`"X[N[G;u~* -! mFya9iAd)v>3MƔ76#ުTQ#Y,ϧ-nLz[APևb69iixbCáқ-/a-RQ`hx%0+M$MVPVI=ѹ&D'̑>JïQ(}E&B` [,NE [G]~12 J.[k?c#Qͩ75Zt+$fR)q<nM7<46!I[|3A+x'#шeI(8J™ad]h@GB)lMډ}s?J ɡؘyPUu&:gOǴ4ӆ%ÍPlS6¤85w͍$ȧ ?eRq樖c S"%;!*@n H>aq(HmR FZ  02w=coJtF^nD,LI;sH~OS,&:O- \Hj ix?brnQ,0*? sD8w 73⹾Y@}n-í.SX tO%1WՁMJ5JAR^^Z{Ǖ5VC2ÔXefdF18i095~6,/̑~K{|Co5)1DTg0TavV#C1m(Ĉi( b( sDPeySnWÍАs{C- FƗ2%a zKޛ>>Z{;ܪ YTĔ<5Լ #a옟x*0 ʋR,"w[– aF<n1-! ƴoabژ5+*[B ?J e՚jA^zj;NhEk0~q&LZCm8 sKkx?c#k&*)|<6%CZ:t &ʊn'a'5G%GmD}SUr4势 EOh<F1яDhE;Iy`"Q Fa'=(jhNAI.dԡ' ׃feTRSԇ6פfVž1Ū7bM^TY#hW qR>V)O\ܛaйiwZׇvβot:6|)0>5O$D&MeE%1JF13rSd_k(6?_ sKkx?S9-΂ ?J\ڍD _H2-6+p0^4m+^^Z{igxi*}5]&(6c rD^ĴJJTGyI %8Tͷ;i? T#K>idp8.IXqI7єom#ߤ9oix4NdrIlg:Qt$Fd1@a8K]mn3L/>F]Q[7B~]ԷMZ".s;h5&LԡE7D1VlC:SrqD=R!$`i+S&+٧氓#:u 9 Ig-Oj)i񌔄9& ꧆URPrk8$a!a/a/=MxR|R*6Q*Oi׃?5ό7%j`mb v6GL(IϳtU`ōZVR7K.L*0n>:JJJTѐ-TZ=>0cc 5&!*r8mD ;((G09"fzh i 8m Wz ^PBQ)."~iIwk7;01(`yAf8Xbl!R xayPX̳  JŸ(,!r 4Jjcm@A{a{i qpougbB?lrr-a#BlC1L cu;M방Z^y%%vñ /J0Ǵ4ӆ[_cK ֞<%a/=VysW>UU!/OxJ" 1-|6k*h( H֪YrQ!mIdS Ψ/ʨD ǹ.zpXڀq9RyI`u4 ?CR÷)8 Bķ vp>W|p ^e; * e"'8s5F]qz+="6e>t<߸+1n1J#ȍ5l|x̔xlNN¸T:R~?v&σr`dŅQ@^c qq ƴzyDupLY008x@[ءϦ Tr5%XQ#px<\{( b (C@>$Gz-Qpd]MAR|= VxZâ(d!_7"l:ܔN˷_ 4ma=] sa,p]Ő*Q*3LdVN>a X,#%m@.$\L ׫6;x#JQA`rX1%a }k F܊6# sɌuDX4^!o~N eT9a|mk23mҋ'|.I_ḬNNT̢KE8 `J192_`wŠU~yYC11Zx"FXG8c@܈(MPk FtGz) Ʊ݁=S'CI|}j)7}chMDT`H DA.̏$ 9%= &1|gs|)#T=mgXk8%a W5excNmV08#k̟qZ,v1`r3 ˼u+yAT [ٮ)LmH8-q8%Kǿ[Oї{<]M+EI,DB/pcr;4샴R_!m wPk qlv9L |ΨmI81?Mtq}c-{K>L# K0c62gDmjNx h).I#}#Qr0yɌxz剱A,Y&!k5<Ɯ]5f#. Yb7Ґ`>!@c S1}^(,(m M!i>8qŠ24$M@qlb4zѬ z4`W3Pp  8a h U2 K8%gc.,Fύ/֐)Ii4}@CI}m>HMQXQ{\[nmh$n=1~98Zi㳉rףhgjz+Y'KX9W욣Tֈ2JsbO"Y!8[+@t9j Y}\$1Uh'xLҰDƱ.J^! #KpTCj w JqL0ጢƿh!u UR]ߌ)'~7ˑ81%h+}G>*U k3dtǤ8WL8=~Dz ͑ t b>H~N p-A[*lK4nHpkDa[tحTYrj a,Z<߯xPc--Srf% +-ʭd(詛W3 igt™FbZ ㅽABgjh$B>W|R~ǯpЀ6T. 2W*)j?TH: K8 ,!{ { IN l_q%'pwq\?M|(sݓ2`"QR+~|:'|r";}F.02^ex']Y? t)؀"W0… tA22jxBWB?&n4F16WOqUJ q0xi!JE!% Kdܲ^)T6_ kf\$0A-Á+Wu`A|Fr! (]LJh~F,סǸh`p0dU6,I~~x |UQzhƴ I8!_ 9^h}h}rиTWܹc`um<=FȏmBUةi844%-GCތ<fTYhG``OE/lyd'CtѸd\v@6`g(q2Ȗ ɩ@Q`Fda") #Ĵ,h% `+8()UheJGg7氐릠&2I:шX0M(Lܱp٧|F:fȽ;G٢Սʔ֐9XR2$2H ޮo^f'g֣ŝaYIzf;%J}<,{9wj%:Vi4}|~kB겏(,q{FF`Ƌ<Elm6*%@9OKtrs X#^Qrv3xkCp M-o-FH@ܴ6lLrmuV>HVQXQ{+FM:fD"#/Tա;ix4@`.Yˁi<|pM8ј,*gU4 ƽ9:jpMlyp,  CAEa Gi upOY.$}p`.vꪍM ӸbOJX0M0jiấ!י(R"㖅:$0qu(a62=L , X$RI$}$n+ gʠt(8K8Bx/Aw0D'0b/"Uila* Dˇ\@)|d)q{p2hLBO Ù5$(m :'%cޗZ.l.:^04 a 0IPgXAsth8K(Dx-irP5-~ȝ CSfK!JҀiI=8<ɀJ:C}f 8QU+JXӇs Xls%aVEҰ}NN:yXN;صK0(peT&oD֝\XLڀizН 9wnw y9+U5Q6Ɏx4c#Q}f϶;Đ-$}-rCv0ܤ!X!c|O] u~@V ݺ8t<5$=EMyZ0M[Cf`>wV/ێ5J+\:Pr6)R[VO8H^?볆%`:-^s3DoЊ\ΎN`}4)؀i@9үDK8c%2hנt4"XnX42k*uM5uG=i%#J1JVa; %-N c8R[@?x]$5h@<|~'; Pur!KkHQgkXY`>sbVRW78ǹ<" F-铔ȓoK@t(,)8 l%<k:>ީ[ԮP5Bn%YHZL.:.4Ġߋ"D2`]f .i$V,. яi:UjPQ}|Fox|^¾HEb `(a1I8t<*ǀq4dU =ҟ$2f꿗-|D$ޘN[Gv-$qD D~0Mé|RC{ ̎N0΀1,l:5g"%$.9V3\nKv3Mҁ"R)$l,mT䠶KB-e MfDEȱ7g9#-{Ը؇P)(m*ZrP8hiÏiTb#z$4l4}ќ}Z(ҰҺֆ%2nYxc۱>4-9߭ѝћ@Vv4<5d4}@C d MA%TpTPWDތe2ǭAOs#k3E 2phNw|Dr;vBD(5(+S40"CTdLC˓2 K8J[xCŋ2,݋X0cP$6c)00"0M^S J` /~d Ȩe n9&zЊũـVh1؄ʖ.Lɱa4α璆,xC4v"%-סU0W5*_ Y/y$4l!KYx >4vVҰ"xfTm|pXl:諸aL7 I"n:]ue0Y>HQQXQ{@H\9Ydȃq4 ڈi?K@"{Ck$vRvHqR"# g ~pU E^mO ȉ@$Z@mIF@ i$% WG @U=+rAoizhTnHT*XrШ4QoR@>"񁘜ZQAdZFf ǂi@g86ebxAՊll8;9^uy~W78Z?2?7+4'L{0oΞȠeڳ3nD<>{"Entu"DҰlDLKqQXQ{̔ƴ/SD>521u; LȞnA}1кtC9Kdв^Z6.Um՛Ƕދ_ǽUxV(%I`>BÜw ĠpA:$2H ATA%gKo tnՏ,re LݤdSS4GF8\ IݳM m݆|-Zjt#l $24]n\* [.H",e*ރ8e291\:Q$GoC$D r $]I />HXAX1Ut'J*K&'{bq3z<+DҰ 7Ӥa i.a Gi ueUcor?zt! }q{kJa[*0mxڈ$o*v88j nX6ct]9ꌊݦn\ G]|X`7vltéhx8d 1X1{L26R‡eC*UQ$8CXHd)֐O2fzFa Gi uvMJs4 Ւ<n)@UV̉(jxDbH Řޫqݺ8{ lE/K#k$1D}Wˇ3-5>4ˆH8J[xCߓEe_ -N Ew==d4]|~JCd;}^M ؇RN(w_=il)arF]4όnhWvф~D) UWVP Ùs_80Oԩ[\@ސƕͻ/K kȂi@"Ne42q֐:T>tY<@_D˻ OR@U/s ǘԏfp@ $ZDvY=9byʏOǀh}ԐۂiN,dAs:jB8쭒38Gokt{<,1a I)FL% I i Ugpx݋_鱫Ҭ{¼JJTiBETDXB,z; K8J[~!!49]uZ05YI8 X 6 Z.>? vI| 5K-g@VaL&T޵uRu>X5qWVڦi>霐c.XBY?!yl<ߦ&g-3Ϣ4!}a4}@ѥ@C>DH[בn>qCVSoY&tF֐~MNcOO%-K+u &ơug9/HmӾ{|pp;is@,%doPlbE6Z4K%itXuf-Q`}t}#?9Hs8!%pYƢLy2$.kF,UkIWg'cJA/OH(B?fpb4Uc4ciQfz =&) [0]4?,\h>>H~Nȸe HZg'9DwdZCBi-HF;,*Xui% D \pOh!*|Mc[k)HxaN48C{ ~Mv<847q/6뼓kx@r#8n h,JIͥ2% Wu'99;6B [Y `:V55d|P2MNR ҡ , m 3p4`rxF; L=.H;8?>CfT\s BDŽF9[;>WgP9s"UO p&";9UCJL/g>%s`gQ9( Kdܲ^G^z^eʹ{@VibzҺb=%8X0= +se}G(,q{|fkv=/D5*)Q *V6Y2]ч}m11q? Lh(F6owa,Bnll-2XҰ=%9Iߤ9\p^d `bre$WGǏ It[A{s;d,C KrA`hUhKed-I!V P0ݺ.fZq)K8FxB[z΢#"w*F p3oO"0?'"#Ԯ=قM"LmSF{^4@skA;757+@=FGp9&hUf*gax)R5դ~w%Y049G{P A;@Xd*Tcd+ 07#vX_-IC($G 2c2r?.D LADFޫP\kd:;? b4웃rA"[6`.>?3m&4xB QB:lH|i<*F5KZ $) @utr0XҰҡQXpUTƑ hJ^KotcCbgIՄ5h!BÙ֐{K>wR?|_[CJrxn~ q/~ HDa h!i@c!fXqiQZ,סKgfYU=82b-nPy#ڂZֵzZqMci Yc߁Ap/74wP$5dtz89q/ ?.>wV/B)Cc0) 82esh%i\XC] //7 #֬/WGbXCPIMp5 DWII8 vVZ8+96e!f#?\ N !Zۭ->={~qgCl -b?]C"a!i6ƴIωKc"dJp83t٢xREwhxH%[zh$KDkPA)H\5&QKMsEDT4}T?|'[?yJdU*{bviLr;cY5)uy`.iH"0IÐտP؛8Kd %D=ѮD|N׼)RL"./^%-e7 Z[OΡ3{12:?^e+)Nc# >A98mĀ:],ѥa =APS>HX) Kdܲ^7PXAd>8?6qRcJ$Eǟ%Zm!NNMY q%-Ve$t%fNk{y_l] s`i0L.)w. tdɧ?(˿!g -}2]P3oVXEp?*(x 4t}VSEa ) U 3pRhO 9gA{ ) cIbXLpM@eC\ 5$m eXhY {8zEU|6L$4l!inej֋}|V#3$QŸu~ ?h@GVkck<=i`o@U[əs2l`l jkAp^;%\ϡĆ.Q,6$#u?%OH%.q R!{ Bi\L&S@bxh_Ť#tXrZ ;f<|qQXQ{<,Fմg}fƎCO:5$ݐd DG_B}! {O=(R Fl:fUuhh< ͗ǂi9֐Qt">SG 5F9XtޣU *d[ƒ>Im wⵛ0(XXҰҨSp^T}7ҀAs9gMYJ- [غ|<N,=Gm8,!oR#l|MX}vAS{U6hw8Vgy?,mU.U]v]0j{馦rt]5(RSZH>!N| i=Y" IV뇺@mCW8b jfAרq5/YbXCLGhSmSG=|(,(m3f(Ti[rQ|niLyib<ֿ}II~N# Y\u"_̿~鉿n{|5$ lLkY\q]WHK!X!c,w@@rX8⠍lgvmI}+ PTB1Swϙz-GAGmUD"VKV[{Sx/ШlHw!@U\vР j| W_YC@3٢_/67k"@z,h->. [ х%~:T]Ku!ᗾyW/x8lJҸb$EP[HfZr|G 7-YR9qߗ ^ ^!߇x{<$OOU9l7G?H ދP`2ywLjzE97l3FL@/gWC07gڦ,R{ n,rACj Nn2im}0/ҝ|rd i0 IdgBk9߁9YzPukFX0M'7ֿca.@p[1 QcaKq北'D"S*9$S1sK4OL]+xdw]FvUȨe Mʘ,&iWTϚmwҪ} $4l!g2l Z= K`TM7^ےL`|SNbۂi9֐ேҡ(,q{|OOjrވsi ވjt֐ q5d(ߋ<]L4Jؖ{ٟ a!+ I_MNYQ9ɭ$"}i$+ Gi uhC|/?`4EV0 ϡDﵓƎ)苔lscM} 3KӪĀq"48?ǨcL4#PXZ0MQ7p(F/,1[xC7lbrꦎ ̲DLR[۹] 6`fp.It!2C dWP`!o]./ɋA[u槂$x)L06m  Q4,1{ zʑK c{( 79cL7[K 4fN-\4۪R_UTBߴON`f?tSH!g.c2 L~$ WGRnr9(XV(D3{qn! 5c'-s ))As?PҪ,Yj6BWWjy-xLgs ,a<ۭ?vXV΃qI̤^;71W SCd]@Am?!it sl mp6!C8#FzXHȜJ&q; **`  NQ}p:ga3fb:Ҹ$PA=X?I~sK88[x/ǘe"Ic21_4ʪ/VZbM>l4\{N 4p1˅P) k6=ϜV=>:yKcv K3d4]&N\PG]ItT) d2g~˷X|87~YƵ0zIC=ڱpTtiBQXQŸuW:mVt[@}8 )$RBQ=L7n=-4l1X1{*ܮ5ue۬ {=ȋ?%GMH7tUor.dBt!Q4(RBAkлjB(7'TrשhtVKVO01!@8Bqӟ??tOiTUbN/:{PDws @ mc ؾKA'j `uo{ T2vpB{k@ΤD&6 !򃘌_W[=ʒa31Pa9 A,Y/6kD)no9~oRDcɝ $VY]20Q@ !shS{3:=81C&BZף!I".AIjGͱI(I>%2jYxɀ3_L&oA8u=7Ѡ,1;bHڃi4N"z/A(K ssZPm@5/!hIGK0j !C{ 'gb&Mm# *pcIOhӬ! l =>H~Np^Gbu͔:9% 3rvw!iauz$rc!ȇ&c!N"g <{/WNͽNofKGF+f4Y:cL@tL ]OaZޫSӄα|sU%T:XlU[bZCH*րO3Q m uks|/z=8$H ,K#_! ]T4_w~JQ 0 uɹ=cn ſ&H]" >3gs%-]5rij_Oe=iW=$Q6ղ4}@CaK',YoIeǃsp&j#6ʯIR%'hҰq͉O&zjkva@RޫV-8'G=ڻp41<$F }lM ]r1X1{4yc28&H l-'Wf"WI(Ѹ!P8튧HOPs t{ ȟ2 d2Z792#QŽ4RAя*n 4Lo*n5bY%U:J%WvF+:q Hn_HtCW]"%'PMB %(UՁ(u6"^[#a~U5KDZy0Mj.*)-|w'C%0usXLsb_"Q:^^ ̱K`Xh-x}(,q{'C MS#4Vs⟰idUNxG3P}H,i؂i9֐k]>Hc! Kdܲ^4smВm>ޢHܩGV{rJqjm!:4D 8jx>F؈tDĔ 5 ؜zD:s0bB.I_*43h(mP1X!k /*nxNbܬ>D 8xHIY0MG`iiA`i4 ^|Z9c[@%Ʃ%c|, SA:4%2nYxCo71U"8ΎJ귛yҰǓmSy<|($QŸuˈ8N5=c0K8t%ni؂yBХaQX"㖅:TtR0 ԾF廪.Ӊ*w/iX(! I/ q>H㯡($q⦅?`{4#A~'c2~tr}{ I.VI*9[42ѡЭ GmUhZ,vH`mVƜ\nךX?aN kM`4c4D- udq>p6,qL9xҢ̏. ÛY0MJ/37{FlO>Hg< W!\[>;%P#?\nL8aԇyp TmK>uD- uQu1/gjė~N*R MT',!{ |C(eLUV)Q4^9ҐDTec$=@^ K=&ҸVȠ{\XO.amupG"/RCQUL_E@i!mАѡ(RZCs9Fl<+76NX )x$cKw$4d I$7NF{h+~v㚐H) 4alxr+ՠlMLe Y0MP%'.+Q#, Ȇ|d)({;4&9rN/Z@H|?="" %j.첁{a 9q SE . emJSn yՊALjbΙ%Nm $k'[wZ6 LũȒ8ŸRq*7ь' (J5ŵHDz`%ppd9.ii%2nYx߿.YMx)n>Qe˫(!M* bMσs1.:|rn.- _epS/?tL}_/Kv~y|]I7r8#Y.;-3K8D[x/B͛os 6qM+_3M=KҰ#4)QK vA:% Wo|6:3p~7:6=83'(E[HȜٍD ʑ|(GЕNi~_~ծU q#Mlr(9ĤId>g}v%TE&B lǑ=Hs?"KR59Bև8̶-SBwZb1Gh'^ c8 )S&Gb5/SmS 1G1JcFa Gi uXJ8p>8M3>-ac0Hq%K&Ps`mE4ʂ%2jYxΙ51fg289o:?z!. iXbnB h[(ҰhRp^)s%p!%91̛U]{ޞs{zbE $Yך%PX4%-W*_uU&ok\doNmV1I.z,Ww1p@4^cؙjmMKgq!p"?p03*IXJGBӂhPZhȇOF,!ܦUTYwoPI7blnIiZʱ`>t=HAZMw{Hdܲ^f)E')H0Ԙn(N%`Ox`T@]FAAX1s *P=ȜARDeDi,x LQT7-44H' d2^`W#u@iœ(-9 e {Y7]l4]&6:lHH~N p6^dm;@gh:/tޝ5BFNi Y0 Bca(,(m,T:R--D)+W+C/*- ۔QXa??' I8Hx/BIU}p8&ҏM%eu ?Uv $ÀID̈G{؟'F2K8Bx/A.nM5# oC(nk/bI7f ,L`,;\] ,W $$Ka/&'Қ& >hI 2g*\DKf͹ _ZSE3ICbKJ5ƃF p6^:яd|a(o_ }x؀[KlkȂifYp4R.H}nI8Hx-%Xt3nt̨ tXұ9gnJ"K},$M03Zds"$("|ʌ]s 64N0軺0!p[~ $]K49{RB!Zf+v畜şGA=WCʟwg&.+ez̜a Y,c@(VᶑK]3Q`v ,3$gKpg*= b8QByKs34;m<s<[bI1'n#c y,C{BINki nmcXCSӶ`>>?bA:4%-סmbQP͜ވ4vvwĿ0 CYT7-(JQ% y5?$ěwgh{pnExlE:2+}Ƿ?$vWÄ,$]!9i<Y~_c{n8>7@zN ܄.=it-%{eB?1Pcs t)i)KS Ud.1RQdJc#9o躘|!17O4\(D}iᒆ}V&QXBAk|p,1qK7bh}4aa s(bD?>DڈQD- uXhJl2'LMSSh56WkHb,5l4}@CN<z|VMV Gi up[_1=bnԀwo@&m Y0M~ƿcK.zNp2^F&g` Gna>l2D*l9I&>%oSk'4-Y`:O?{SiQ46T—qb I>a@a280z:0 HLk{. 87Q3Tr "@V.E'/%==`z+t8j[XҰ%% ,%P 6(F<戫S4%T(H)%%RRk 4?Ϡ^ڠ ǒnn({V6m3װ$~"s#%uOwI:s=1w}pWgoF5/WlyjQr*qPHN r`:4BJi"x^.yi0'nZTo 8?DiqS@ܤnB??hkcGW/#>sR&!{) =ͥDnx^0"H.p`6Gqv!f*@Fޫ? vEsrxH}]:öKh(`>!XX5>HQXQ{WBU) ̉R MNy֐DG ڱ z{>|O(+1G'}FH m up'l3SQ3 ,}L$Rwm!cOhVtT^ωޫ~'$FcWoF)s3*Ab7=ijAqLc]~{*x٢sH9֙FJ0B6n/cSbkBҗuٸIyCt!V?Hpب(_MéI ~KY,}O؝zp8Ȧ-[bRU됎5-ѭ! E,r/|iCQ{~%sfK {J\J.`Řtt G~DE~vc4Ɖ,@}BN!/5y&f Z"jL)G\*:!X!{6tyr p r5 %^WЬ@5aHM"lUbO.D# bwK8j[xB߅е5p8!@i63p$FV[SWzXwb@(V!XNi1 + NA#l9obzrG*$L Xjh>D#a$%2nYx#.2f. pQEA.'- R"+P* IӇ.깔O LJha\6,=5>/'m^qkI '#Qv,$}d"9CЁ'p| G!RgF}2 G4/f-1! gXCOw>|(,(mmy-,IJ&`y 8x( 8Ķ, \'38:- 7%FkY;JEs:kD]׬ɳ%5d4}9UA֠DF) ֡d{mZ[rq|t\DcXHv{M@,Ь ГSa ܸ xYAޫ`"xNJNsi1*ʅLyZkPBO䴐4}|~[ > QXQ{ͩ,r9昱/Lt9VN9H ` YDp`l!,'OK_*YI)l|>ﾎHkEsDj+i=eZyܰiMH.y*}! BF{497wQcZ HhS_b-CpY@ }n.:#q{2%ZMS[L4Ie)0YDWS'Y̘ϐBJ8hu;A7oE:،(H*woK[V7]St86I2p١$2jYx_yqxgF*𔢸S(zM4Q VKd3Aqz89sh`8^4zCofM碭o.{?K$I6  OFԿ_NIqSp^lgQo7y-ש- wHh I8J[xC奍#qɶY^*N] B :M~xC`pGd}t!6޸L:JH~~Np6^ ޶hQ(1R575»nθ\!Q0&8-$݌ԙr;! BoqLk^SFb4N֐Dmu# 8&Sv@ A,wϗI8D[x/0ݒ Ѵ_ N:qi֐Dw,@] , e M`ű`ubĹ/vѣSnsJK`.Y5*/*.4r ,Vq=Puǜh^YkQq'}=Dϑb+jBAGNȸemQW}AT=_Mo{$b~X]KdGg: =CDS<Z>?3q'w,Lit`Fa Gi uj#rDZ!'X!̊;DS|ZA(Rr s.B$A"vL+3qeKUr&Q`G*Dt]e<n҂ᖪVXҰ,ׁ|9Et8IY_OM!n'G vdoVQ7b4Ӷ8=ծd40 SE# MwNߍRSB_ҐnT W?S&N"#D@7WNI?Gr{h']]`Zw}ҟ% ~FE UBE}pi0_˱"$>D [\t8>[v CgwܷDRl69`J_;3| #R2\qHI ?( އ1Y~[@Ύn\m8IH&]m, ~V{;x }~Mp XQ#im_b\dJl 9Lwj$aUB}4jdp^ߑ;&0Eb1?4,Bc! sɲ0S>K2 Idg4?!Q=~1Zj&mÑ^tZ&e +zH_*.K`,yl?h G6]~3Kdwa KVfd\.x} E<eW_D Rk" .`lS,ԡdb :JKa[ЩKG'Rxwf ڝb%.sH1::<0E- q&jרL4}Kt~agʌcè:2 X*! ^utV$ x}_bV,`ګ) H/^F|RĂt p1ZB'$+La+-:Wh);" J7Jn`]G53Ї0HXpS;%Q A6wh ^l.q)јhVllԄvhXa )`*[qJ`)l B;&V|HK&m z{2Ě0vL8Z8,!K#vL*c+(SHK+nox'^ݢcAHygPñ'M `* 3 wq6"(Da UKz"MwHք!H`:!L1$سjݳj+La+-:WVV7+;$1 C"|XN+Na*{]BE`A'Ya [i qnߝ {M?1Mׄ+p$l4t0[P*5ZOw WCx}!=E3bE+M /kkDдaAP2)VqXBƒAϭʰ6.PavZb8Dq޻JaӾG/BNV]`N{"N.ȭk M6!(+s:(&E*j r*Xor"X$k( SA3K$Z%e~.LJ0fs"Ó\S*1Xa|/d)l\GŌ c,X$1#b8_a1^L 3'vj9I0=FԲhP+R, <1ņx.0T4o9Ĥӻ]u< '#La#-2 | 7͘%"Y+]N!}j8M~)Ӄ03iU4&4Y!(=gZnXaJ8"Fϴ65s?bT!;%*#w'O}6裷ۖ`XqPWVuŇ& BO v1X@cna.aJ66Zu'W6M5:!̪/̄(c2D4 [p!& F|S@TqN~TEo[7aI6_glcYq]c`:@0SaZ}ʖ2%G^]GpG?M?y|ƠRf՝i5(G<=aY^=)`DaT n)l%\k̎vQfQ,L P菎)bA`'%7u ^acbFv2ƍh5 >fm`*[b"5p] IP@YoK̊.kcBӂuP/)*/hQt[G l"q6s87$)~I0A Sqxt5Rfi lcƋ[ԅ}aPc3 8M3nJ ̻=A,;dJJ9jX`y-23'f,8 L*HrTn5 hQMXlU˝GT<*(p5vzQ0~\Hԁ08,ab3AX hױ⥥1UStZQ9N.Kr~s*f7LfYW.=@Q` h AX EC;Il[>yGBRD$!~L搄H:ZVVZuxo$1rƻ0r/"`Y9R9m[LZ[/p |d~N|E"#$p EWIE`d9x`.*SARAuLVKu6#xe#DA,jOvg|?K! GWK K!KKLpAQfɍ(V="`f?u}R⠀ŘSl_'xQ(^? Y4x N;G5 I2#NED+.r-S^'cg6Ov͝7}<0 $^cQh9&I`* 5̫A0Ĵ!)j G6lJ MuNɋldm,M$ S?afh ~l~>"}Lg΃d^M#즇g;#M%$?1̫I (C]08^{PwFl;-|u،@dпyND1 s %j`%3l)l%Fq'6oJ Rp2tv.87|Dg%wi.*F)aF5pp SJKWOd-<]FXKll8'PS %$dMH%Twi)nICYb#,6첞OpqeLˉ"Û;&f5$:y' [i qmE;fKtP$|IU P:VŒ"7{|x*d)l$|57QM -BE`habat`lɑmy@K0 r G YR!/4")jIo.;Ƭa|BsV3($@ 5GDka\VLL0M sׁgL}zcgg ظK KcX.%L)vH%:RW3=ag~xV rW%pCIʪmn~H%m`rcxYKIWTߚfUN;N_`Hr#DnYa?g 0A+7f( ݗ,wѨX{P\uχ(rw籀 iql6&ZW˷L'f{0" ,Ϙ("0uCx]! [) _m`2bFeNQ=>y%6H|(Su S>ȏλSW =EhAR@_FIR'HQO.FVƷbcJ)s$<;1Dw$,8CqI`-:l(+9dC9`Cw^iRzGXu;Qd W/qCyӹ -ZVW_MQĘ l`o ;ةֱ氝(;7 0Ʀ kGn}<\I  rKMa~Aw *R\Zc6lrƝPUdRivhW%$QKaVVZuXIo|7r&6.lFr1E1C RNHA.mڶppSf ua^> >%f [QAgG] 唽SM%tx$SC0Ra [i q6QR4an^.yn܉^n(Ζ S[cJD"w :*JZ!"ƍOZ)c 無uJGh6D S6 cv-WTLsp<7*KHا)搄(t>n SJK)w Έ\JFMiWua5"sSD S"Q%ZaA| .h|„nQ(Nf%`txfr #L%|bމ % Ɏ{&'EZY_66Q1|vU qNbv۴Є X;+t `OzfVA8l)l ",q1ATp2x%a9DQa Cb8n:\0E- qv$u2HcnDm K(z^tfb7ö٬&Oposxfyi[8SkR&qpI1m%8;yۦoED n)l%\O!WQ3tԧPiegRT EA~5|<`O8(ԁ1H580>⨲*CWU)*x1ȷC3ʤ1q`[ h1Xag hmĴ iY߀"^ň:)!a0+OSMYGVJ+V[%+%qTU'xܺ&p7#' n>6%,|LkIa8n3oH>^N:k]f oJ1Q=U1|x%/B `:NKX%N˜Ei$\ǡZ`fA 4bha.:']bH UҪEEAoupL{fUt1[nak(okUצlE)6sHaP8.0M6XB4jO:fQJKCz= D䭍\OrkƂ88BRMU;BِŮ^d_P!B!X=EC8]{ uDTţ**:70(^_Mׯ HmAWTWfH2WDbbg_W^j@,;Du4ƄD&)*/Qy[37A+'uF =v S2&|Br'<_b:LGX6C8,\UBx0.*X@ui|:I0L Čp:06BnJjI2<0߽ Pwe\u(3nŦ:K0<Ș(u<@I(rNG>yEw$ ~ȕD0"r?o6wƒ%0/;` h!laG fu (PbGgR 9|"Ȑ[3[@\t( 6ZuXKZO!UZcX`39RB£Y&%DfR-H [i q+Sv>Gvȃ(>,C$N@X|?Y頣엷Z3kTfu/c9 y+y– \Ϣ3~s x t= ϸ"-mp?k4{>a*{׆M/ c)M)`:aKaSmSݒpeFvBTbVhfPE`y1_1HËS:f"%TSEuRT`Z_U˸gu|>eqMXyvNƘmsEOCV$8^,* vq1e8R! b 7cĜZM0M$Wc8(TcIӎ 7ke ;ƍ N`X* ̶Dqm0H`mى6j j<)̲wwLj .[fˆ2C5b-l&1_'#XG#Բ'|0n>D$ Ƭ)1XHSD_} c-WNa g(*#ՆEU7^ S*Mpp Q82Їwϑ,R [MX0Ō.!і KVVZujQ%q`$ F@Bh5eX3{ƒ:ʦBe>niBRDK1?0Ng܇sUG%a!(pzC:;VVJW8MJH &m-ޗ Cy$zI1Y-ց0 x}w9Oʯbz>c7XPn|a\> PQL/vpQm#dj*'b}onV"t|3 ?=o>ӻ 66["&mB}AvE+VOƼϟPuLߑ ˙(1Ib2uFt87o&1++v'79oSkk߭]j4ocvo"o]۹}Wlw{b*!~j%~/~׷}K%bnʖf)U{-1g:qSsrI%̙jP4<21*z:YϼqF>G̬uyǵ.{Ke\~qcԎsAG+z ̳w'C54,OcݾO߾讱~vr2v~_Ӈ'-4NVD7K)oۣkbq[i C[PÇ(P9AỨ6PYc|˽C8>kA 6,?FSzy,yCUOMgs| mFfSOxom"tmdmaOAR)HS(7R~t__=xok޿c(R_^mM4fa2?=EB~:BPv>|1m܄/^>?߽}dO&O! O?y\??7hˋ~gt??| umSV{xE?LhD?޷G~|\~xol/7a_ joߛu臷~oE$ !(<4QsXg+j!#8=Ѐq}+.ve˻=H0t?S_9ޥHFx9{w\#V燧9lw?T4xj~O}2??OƉ7m? QcxaZF)㧇x5(5ޟcv._b0o/S>il q?e.bn-11cJmcBOGl;gLiDoԦ8 >~I>??x7_>=?Ǐ_,3K>C ?Ү:Ƨ4 JOQij/̏xLϨ(?e폢j]5%>@K\1AT\ۻ/ڷHk~j^,rlC;~g,<ڕ5. f\PPoOǯJq #6LnK-诫Է0/K7lYq0 eiK]o܏P/{1JEqL@(K_Noԧ',0UUm^1?OXhZr1*fژbeLU Iç=f=kGAoeްrKh+'jLÎ??<钴2GYp#J-x0u{|lY(xc21/˳'uΡxFfv0~ ;.>GtK[Z7r ߿ȥ֞P•Ç;,D/OLY\1|jXt?/Kr`GÖ?Jmآ=/endstream endobj 513 0 obj << /Filter /FlateDecode /Length 5305 >> stream x[[u606/ҋ^bo3+l8VQ9D@m pݴ2Kvk=9*f4ɺ:\MEqy7j?ި{+CҺk\*ssm~۬E|],2y!|V[,0B[F^)h Y)wپ94Y`iޤK36Nn/a&' -~+Euy,th֋{QuM9f}!Yͅ2?æwٙqW'˥E3.OL\k/RܗEr inTn-$*qTSV8Ռ)Q>/47bfk~ެOm̤BST=myoYlkdz?"j` l[mjZRXF v8Km̭-z>v|mEQR>91hZhsGZNiW1LiD_R~3ba ltLB9vuMo$ꇬ7y#URmS8v͏xh* ":H\׿8%a(__Z}Ri. ]6+\Qw] ܥ>{{ ~|( ]N0E x-PYׇUݽĽx ltsGj~{]{?}+R)4U.w.EExo31a5^, 0V@ITgjTvN%0]Pqd> [ !fȁJ#vS^HcislA{i`5ylpǻSMd8q۪]xۗʵYdeJ\؞[vãRW%V!6*Yr(h5P,,Ո+hzS):~oۺ> o2$A%B ;j߇<Dӈp@f͘אFwuGCC>J&;T3(PP^čJɩ'X aקm`BSE꾫ΪsGR&%N?^JP x;UHSONˌߞuJZz4Ma0 INY&3GZ2_á$(?1ۭQdV}xLדUY 'oPHȊϾ̾8v !x"Ϯj>^݊Jp ;@q8ξ6mu4?*.|kH;v#[ lp^Lu牚`+8*chG>n ֿC*E&``[) H2~JӃF3 M0AmwZ lL*%f ǘ Y`rEVBwK:X+S2ebΛXe .`[6\w+dѮ'\/1Ӆ" nnxs +]{@ zl UAvդ;JhUmpUR/vhTv5c@:]hxWԧ`zzp%sN|Onw:ϳdOrv~6=]@n*D"2U}ͣ7R(7Fon0\hbX"|t<pTWS`JIo.zc.~jL*wy3Hʃ'?zn+'f6|\únQd涌t^5xoGu@=kP^դQELxZyB/ ZDBg0Y%iT | [Pl?ܲ X27z^\>L $(bZ zS3U@ TvdU۠ 1V2ܜCA 1ܚϺYS,UW' &YteAcC9 {>`z}^J4s7Pޙ4˒+z7BMhXs4DY] ܽéٛtcN DcHau" F ,"7 iTpr_H 8@704=KD4ڟ ? aNp7tSX,Qsƀ5H(8G@b'1ĄQŸÖJCkmF%u ?`)Kxs# Rέs7dG}$ƖYe&cӬ2tjÇL#S9Ӹ6Eť)\(їh§~L)϶boɊCN x)p_;cN!!Fk2g h)=灞!]>fσt5 3n$1pb=Ԛ̞ʀabďKKy,M`nCZlI9*AG|kqAorԥ,S 1yrIo),\.Ԕy|[f[ ) @GzVCṭwpMba=VaBp,=fiLpb'ĶUj= 1Lev!VB\.,V| Q" 7ӧȶMVWP^!eleޠ_5=x(Wa𧢟wfwZW8>k:nq@!0_M3gPէ3;2/H"jMGӄ,$3Mo&T#SGcz\6CJ }p TLqpߝ%/8_dͭAtҜFf4(/ Y:,g?ꖑ2 ()7.HUƙixKZHkyy xR]ba˅WRh}ÁVMaxd`!aof@3wxY[9+; JˤO,f D o枽ȃg䏌6/dD0Q]Eۄ0ofc /w@% ΠE4Wol%mv(3DGW'W.`˼u+['tW F@G''~k >0?X R"*FX穌Q_h 4=D AĔIzsgbBQʠc]pҸ vn:7Ma(+%7i!㥒4ZёI&i< bJ'W02_ !GO121QXyx1 8{pRķ ;tz}7,bnv*xF:dzaL*./tB٘x\h[+re`w #NF➘f)uJT\)X-x&TtH(\͌Rtb3FLxxYHwuha&o0Nh' wQ7uؿ]27]R?/цEMsޗ*i}9}+>(|.b$TN dX%h 7UiÅ[<$z(]4n >>PJ[1I={T~wR.+q}! R dWZ]be~IȪp N.,z+X#W|s,zㆄ(0(PPX ?Lv(6V>&%xq8X^xiZ?Qr_HK Xf $2"C>2 =Ta(,tU9wȂ#ӯWYGT?׳<xVw tqAp\]Lc׮Lr䗘h(),8ad;J;: |etkwYOC#\&}P@0}}ĕ{JݸK8Cz3[r/GP-H+od"8:Wo0j'\N\k{NJ/aq5uHa){cVpbZ.` YSm绺jc 6_a^xpQZBrs$=~:wԎ6݉\tnMp ;r va 7?V=Z[dk=eBQX1DCs=M CSN1 iUxSw\ŤMi$4aMDiWd -ݷjrTV +idY]{@KtRԏC30")a3|:>Էs[s;K:_WGAЮwͪ3j' ƇK?>۝g-{ .z?BXJ AaI6*M7.F0RWfCZqIs?A ^nU*[i5tÁMR#,i6w+\,L9I/ w6!G5L"une+d1s"C@XPֹZI̎8 Mwߢ>*cJzDR?*@l+p|OM&aU p^ AQ--{A2H=+ ԛ.{Dk! "hЮtg>y@z:f˒mBU 4G)_/bŦF^4t)K~p~"_cs E46QѬw}!NPY9`(k*:~t(jiXcXw79Ρ}^wLՆ`]);xAki_=h]'Fpqg]'HA5:܊w[w K:]QJJTcG]NqepC !d]G[p{H92m|]LCQ%CiBu*2endstream endobj 514 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7656 >> stream xyw|e9""#'f *EB*H#!齗[:p"`]]us{I}}{‡yW7yAX^^ސU V:ec8o7a``؇KGBp=G`̟Ysjw\W?aoa#_P,|ch֥mWWZjukk-y|Ҧɯ?)Szz?K3fNİ !l%* &bk:ql=6M6`'l>[M^aOc4l ,{[ ^†awc3,l66QbX6#1 FgXX&OwaP٠%$(s9o(ﮅÞ <#wǽF:o q/<7fƘEUE51?=HS?_6@ǃM^AþƆf ‘׳%gG{>Nu/h+ pD-)G-r-t0)|}P !Aݣgn.nKœ/WBy*((@.F`E@4I>Jq%$IJ]dyf^:\$WeSo*&-Lړ 8lwu2PwX^m%vkO3y.w%xQĴ]d/.9~!qtWYù?rh+bܳՙ'ch5{&*g7h鄈Ecp?C+9OY-U6 ^]VOTeg:? 4XPƨƤ!imMĽe*]OfL^v|(ˎDTl R'PnM',SW ᘿѐilmlhzGQަ,[ڕAqҽ|.m T J( 1@8S:G푯6ŜH jscW/=.G?Vjr er~e [Vbvǧ~?ܵb ,&<3#py(煛͸HS:q@Dn(;oqvG!궺HʼZJOY@1 }EcR шZj5Ol@%.A=ʌUfٌ¼q@:ɤ~+˼8\jVˀhog}#Ia$n Iߍw]CإҀ,IN"g#HQ{8uZ.p{prQ%f:]_\\wypM.qR.q B8[! &T**^-w6V\Wx$=fb_()q=p;@Q}8>,3ޛ(4 e*?̳S▻Vy@'>,pkldQ;^ ,P"(I.K&J1 Aû*j T Vlڰ%qLIwʢj`DQ Ԅ$ =ɘ/{u= |n%iM\2 ﱅa[0¾ΪC/.߇K毟6UC ? r$Ȁ W adE]$LRQH8'ggJr \>". Q^KiP⪕ڕ2cUmmm}b $%u悚s  Cwy<;~ ^,؋þdBk&Nk5ʔ}1 < L &4-tiwI<:\DN7p] @$"~Dɸ"#Q&jn-H2LP|ʄ?Y\0 M9d|ݏD:?I=Vܸ8MMPG'ȵH;MH* Ug)*] zQ#t.f StVїjЕ.92ц1ޜg~{3 ʭTSFԯH<˼M;.WcL6Jr.οΟ8E:=/⻄-QnHdv' .?v_S"iZڗgG 5FR.)^o'YrW8 =<۸v @(0ʡ˝;n ͆({.&~_WqSu1qNViv[uxX+Ho n'O,BVT+?􇟕4Zlk&cVڣS7PiKZ8$ ǃrW ڍ\;Z>rݖOtsHd[G?SQ}#Gߥ!4,0e Mژ@r_e@_Ylև"yI#":&+ [ qH/t}(>ڥ_)Ɓ0[{3yߞp5vv:َ14 } ^g?j=qr{=Ȫ nNH]bPLbzd ^.> Ns0<{@wXkA@[2\M(Wvk$ШPyL? DalS4jFGw4h&co¦hw~kjHEg7 &=QIW4] ʒ d0ȵvG<@bkټV_Q!ps^ RP5kљ4 #f,c f7tE`Md63 OGD8w,1#f>/iRp@J5:n]p#fpnos͉x"u;T{QgWzAD:-2WC_/vf `/GM2KqB.A~=~Da﨡r6Pv-XGQ/߷:v0;.e~SCHkKQV_cI䪗flYV S^5Lp+׵?vmQ_ȥ~h܊I19⿜ݒC$ot\hOxdH=ٟpv&J г#.$~ߍ?9'o bs>[h;dݭ[EBR(#u *9oXY7r݀/rc3#s9Fx9;v\,ac}_2~żeXi / 8;@ĝ"$Bϣ66 w $<]6RR )gڑJB6jyDplZR6T:Q n+F1Gn(Ȃ)`{~7]V 򈅰QpOX:X &!nƥ,b3,>NGFp`ލ m06 R2GnPh4\΢Ehk2I8IV)r7$ 6 "6X\k;q)X'ÈR$?ǵM*"m.21]n " 7[ynRiJAvDcȇŕAI`"E Ҭ( sjFpRQ$F ,l&.|7xG6Q&|ێd]in yxj)!p/S|ȭ`4rZhPK>˄ &Zr\ThLZHH1aC8{Ncq%wsv %o/3$ZV ^YWյ:#$ކd u"p椒V4)rt0?9=QQn^[TuvC{KuEQn#9ZPIT!].GKcOZs>|ޥ؄'E\Lp(UEEt0gpX7PPKLjF6=}_WT#ըe1Ҁ4#~s Eb JD! yD|zh-CēG pn[(68Mvst4V 1Lo? ;J9Zy9]n@[EUT8NY 50@#b]ϥ[2(hE2 YbhP",5: ^pk6^wNrN1l˥Wi64#5Q'[R9rvw/ 2ggC筥7.XAժU oAq[J0ͷ#m}pcfdv鹒 KUα=k^ ]M..K7'6X< O=H7HRL9C/[@ !deKO-~awK-epjxR1fwvq&<ԋ3fKak ;PMȐķn nWkr!f8p7yQ'1~"]څYA@}!NwGu{bco&7:R v_~͙]Rbb=o!}$qhgǾs}ϐ*1#}Bp?XudBdV_xuH\ _(_@M[Mcm^9sabޯ¿ [(8 RVV̼{edݾߑ  yl -I8Jtfca3yQ(ʙli!ߛC}[ƞZ!T|)e[lۚu A(i2%D!c˴zDΕ\њ)$!izS{6~u)F2\‹K$Qfzo *оX(כtV)ٔy`2XֳLDp`Q PR_YLE(q8>y"ȣ AVljz"&Dn)""HrNE.W6o뼲o(urYZhd#fgX*." GbG?#/ bIH֕{Or& .IJ.+{RaUHbnrqx` * $+'DXOWy\HtT;VXU%4h@#! ɢ^ágEW-}Kx\V(dRQTP6_~SDQ%n$P$|u#-[_^>ibz zQE )Gna5ToD8Man (XLprhְ!^endstream endobj 515 0 obj << /Filter /FlateDecode /Length 2419 >> stream xXn}S Łةk$&`2Xrʀ jcG\]G #L\WL)M!e{vt>jy\^1`D7{Tw!oPiMF&Rzyz+HL7W{(KrtSR TB*)yZTB*)Y]J%JH)enqAIRV[Znc.\ˑÂt3D|Ivemi?[,;wK\H:$< KdB0qĤd_{6{\X I:劋n3cD3go㮻t7/%Q{ Lr ozv=nuZ, ={_B>?c3!/`<{}xozጬ\ðJy<5WۇSGa;&],ZeE{6(*;‚|Zﶛnudo/L/!ō~^n$N\G C]a9ֲRcayQLBR`ًqئΰʲm pR;f-TH0tϵչXxxuI \zINWp:>=1S8'$|-5v&#!GP{5Y lMСҺ c_K#9(J^ULI>'iĵm^rmyuDkT\*c{IC7+̻_|uY|ۜ5qs"?.nnnc)@Fm'ZչN }&rs@zT1r;I0'6n>$\@L= i#5.m}j26]bu!Q׳jlj0:$-[8mw4=8`ť-8"awѡX YO&:tt]r@8[v8pyFS9_NO >AxQW PY͆[VTKr.l V', H8?egc"DBзy3cEv]h&UٞK¤Rw_1{CVf>bKהּ#Lq4dendstream endobj 516 0 obj << /Filter /FlateDecode /Length 66253 >> stream x\}I-A~g{ $($C1m@Bi iKb>l08>?yޠ6.k˄ԅ:Ľ$h%!1m,%1m S6m8l sKkxc;{GW͔vK|[3{.-Hג ,:g% J~[{[;om{/j/+#q\kI֐6B”2~g5Ka0~q#n.K 8ﱼ%׃Q_J|nm8ZЗC%nDx98=s;u^z쟯u+ S;ExI˚~}s9>Hum='cJ)qz.>ZQmi9߼LtA].W;c7aV&eJB ;|ke!`XgxgXRgZ#e޿qcS,?J8 =0=0j9ä?v r6unqI ƴ RSF ᐐ!/S{duuǛ,\T<"52\^ǝsV`H -C?a\19c^۴KOW7hk+/|xzh1%a a#$LY5㻼m08x7ib}PR[ovٵNY%a ƴIYx-ZaA$̑~K{뉙h;Hxg<6aYxMZb<09$!1s$~ᓔC..ZczLWX'|_٘t ܊Kun8;G6̘Rw6e#?9oixY1tbeJLUq͉֟pL KsIHl@KPCL6??9g|֣߷X´̔%{<%Xh^'Cc qi/}Q$a}AGY^^Z{]16S9IJ^|X׫ K ;k,6Ǵ4$DY3(0Hz6A/ a'= .V}߰LXܑIYwIB⊹b1T%9a re!1m@ϖlʆ0D"9.KPßqpҸfWL=ԤvLMOKp]TgRV8>}I<& ʘ1/O>ma89GX__|L, L=& Ĭ>*(0zaAh ƴ S,! >LqH sX5I,&c .XoL8SCbڀ(XoLq sI*3 㱌;oKli/l(t\W,:0 5NҤcJ 1=MAɐ^K{M-yJ ħ9)x{vK8%X&?6JK ,0Pb1wm!!/#8d3&NR:QZ!Pgpf\}u%sZ^yW' 5[vuҾ~O%xsE(ܨ챉}?l,/_QXLyܶnHXq=SIWr[76-a\M >| rb >(= Xϖ͡zk- kz4GC1m@”& =qȉH= rBq[~pqLxbMkoɵĊӸd(4 S> Bܦ 7^l $`kt8hzcbW~sTIXCbg6@dk b%a9iA7} }$[yی⏹hG S6vP-urB|d vNokg)ܵ1sب.(?"56ۺ4W&.${9O{&Oa vb̘:Sf}*o~',ܗؔn38U fV!sc}P֔,Zn_XZ<ٔu84L) 1*9iixSlWK;v/|:P9 R`L射4!϶Mbl1G+xBDw˄x1_8^;̧I4pݯMY54lݙ3Cv_Hgc'㔄5$uyRpJ&NGn'a'5 n]F81 ``PP1.y` C~ u䅫椬1֒`h̗{Ji)0 XRbB4 m.C.Z=\\>(q&n80sqkCO;q,r'X/6ܬ`|9))S0mL#H/84 Y+Spb ‡IS5hO"1>ؗ0Q֟z}SZcba ҏMXRۓ>0X +yqcOe{]m8$9oix=e] ¿бVq|#3& stikH\4K(mScg4EO}pD 7%Vp z80}(82Fc MmV,&CzDhUQI'nAH^Z{;a1i^Rv++ֆy6AD\& !ʉnH fVВaئLFƮ@X8f$̱7fZCCybIqt 1&rvR ޣwF\IYoj|~ u~l665_ԭ٦l 74RMI X/T]31ֻxoa i0 PQmC4L q6b>(ŶrMmeؚ["Y1J _0[9N8PB ]H n%g|ʪecIHRbMnhf~4QbgJ $l8$95+wS"wSH]ŵ/ S:iNcJ@2m.+xdƫK 1e+xQ#&'g båX~Hؕ9ckHM)  ␰気oe#h"zN^!blZB>C1m@BF4 IbU95scji^[[9="_5^`ewSI6ƶ082GKDUyY/6aM?`{'2ӗXj'La,&.pXȢ IA \xVGTQ,âmC.DQVBVvރP]`%gzPtF XO;Ic8GYKʰCpC&/]{|7Vֵa)k&Pe,^؜n-WxouII1m@”#`t[&CN#ݦ(x8ݙhQIāU=f4s0W8Ύ y8)`y¥q !~ F`= JA;Ck'cvTQhE6[qǔŅ^;8k4O`{V@nXK([gc=(YDaaI+Jc0cڀ(ؑx cJ..B=~"=UŰHhFo蒰OGKjh6 sKkx7Y cIa ]0a^ڇ^mE__xbwDcBq-  氋g"G~7\l6u,q)v0GenjH|0wSNen 6eX[PCs+6O On6n#DS }qQ[ư Q"~ >p6Q@^^Jßqh͒,u{P"8,E1U*rw\6k(M҆0p"c*xo􉁙W:Mk4P<CSUJAL1j9 /Š c[TXvG5$.A!· bDI domqb-8z\XM^=qLtיY` 83<R0Nl`:vA 3?e)QxS]0)Y[C;@rYB6׻tۆ0BUErKkxґ獸3C铉q\|JU#ZҍVL[o9Wa)쳞:! pQ4]˙`XdUn{z}fA="o8֝PC1L SV&>H; sIkxB)ܘ+ؓp+.u7.ͩ0s1,! 4J. k%fa1-!9iAd"6HT$᡹uEl+zыx. z}f"+r#=?CP,]ĆsL%Jc,INvrÜR8LD`RK0y$-oG'~I8jڢ,XSAt/構HBFH$.5 %^cM 5g.Z2%)G"y0?rgN0G|1[1m@EtA7ya[יuh\YIJ㱾)Qh.+Ѻ>bx)mL}3mm'6!={| gevƙnJ̋.kFD纥hCcT`<[C|6A|0}(?iADP!y`L;[Y񛝳}n .~EYUkS.ĊK! k>2A{>>JQ(1[N'bf0Kj{$?ⶴ1~!?4U#]8Wdfa'rs7Oqa*C3,$!qU. ]APMyT #)g6F{ači HًqsC)x;1*dt)2Z<*Dy8G kqcl iĪP$5&3b8brnyi ơU=i}Plj%&ȈOǟx0ԓ$a8l ƴ S,! oqO/̑~K{|Ԇʗ[cKJ=u T 3K$q YqQ2RQ.5)^#8xO9PŪ֒3)¿8~)qB@D?5S.m##+:ｼx1} OehMbxR5z{h0 HR* Ɓ0G- qprND?|۔Iz,&T|~sQxhH|译( k( P>=+a$l|j"WB>xnćsMH $lT`h A3]I I ؖr cz]g!kLm;ם M=7}S,wpaJb{aQƲb5U3GzGapΗZݧ\ ɑNK{*.V'O׳bꊝ\l9Zg7q#)UaW~ c#={muCn CqN e]Yk'mbO RQjkh)ĚAPbʼXapxw#MIcvXC$Te2Q0(1<".֟ qA8kܝ0z`< O )Si9{ai9tIXCDŽq l/a/=r[lXr0JQp|0;.V4e9cd Nq+Cp28q4IX1m|~IXCCum=I#88 6 (]P bdS )P`Lx6M5 GJCb^SQd!3e%e2=\\2$Xg05$>1fma2@..B=މk/=ұmү(0ܖi7 ikFStJAEY}0Gz-Qpdjdא{mIdsgvS0f컙Wr[Xt$0lZ*~ڊ͋aK=ԦCwS~=ٌ; Y"~݂UI{S8Ȝ%nKGZu3YTvVGR&ο9U[Js aLQpsǿmS갂A[ ~elm<Ѧ 鉄c|Xu3SmKHC4.y쳵}߃P0?| g՘:TYsUD/m i i0H[C$1\Z8sU9'RĈ 8"E1IȸR#\aϬ_uGDX6J]L=Л6uȋJ"1Δ7+4Bre)x3:1e !w"@ҰH‚I,! ƴ QNKHCįؠ85S{"J[yhNsQtӸFb c:9buMzc3 m#0^$L q( LZA"L](p[@ O^2,AͲb,H, hQh[XLD Xn*(V,MkuMO ZBd4 /Gz) ơZԧ@7 .,(A":T\QiH\7[aA'?^Jßq0rZNJ c_|VnJub L)0/p\la"LhV) M495FwkS"X3 4O9PYEI.f349 %!Xiۆf]C>. ?[&ex$sFɺk(]&$!IL[Ma'= J>0I 72?j`ݦ";xl|߫%nLXwr|6( ďsgdUPfwS.?wW|vk!9`Ѷ4Qdtbn ı氏RgMHQDSd2 zT6Gm%La- n/DgU8C516dvs}y?wS P^O C6}dV>DHrIBmBR ^[{8ۊ !nAmCVFb-!ql 4.ԄOq3&%@'^[k tPGi*Ԍ>8c&n qDy`L3lᐄm08xbc}N [<9Ur6?y4$SP y1.<0GL!(dH qO qp?I*_0Ad#wAQ&3{#'V< b iBVn5Dgs l`= 2Ļ2L#: [z-J@8n[os6 a ^٩@4AWhMQh+}YgSnx|P!~֓bV`L!aʴJimXg;h8yaǻ)qrݮ- ǽ$σRg qdx<_>$Cz-Qh7hva h5c\(=K2ݍx{cn$a/8PLlJ'-y#ɣcZ!{7e=l) m195ǡKNH :2 "CS6~]4Q6"`Ha qEkxBJU341XED=1)+ЊeG3k0&XÛm8$95FY2XOjK<4͢M%k"x昒!NBq5)8$`l'a'5 FϾOʭbtPMݤWJTRk0(/)S0Ѻnۘn^^Z{>,rTSRn߳FM.dfN#k<:քii| ^\0] TH~P9O4vb X<c/ s'S֐D)>XAB6q 7W84ź"F}!E7Z1X7+#5l\u! &1=]A8S|v>("xoA_R\-{=xj"X%<H O sR u,#}PG:yxD< P,@ip b"P>G)3 ~ ĉqhS" {Ou+D<!2I ۧ&`w@?}+̐.K{ybS|BZ)Tvi-S<񡉾)QNm@g0 qF'a]7*)8Al!h)c*hr,3RƇKEskRavy!Rwba7)Y^᷾`)%a$K`\.@bp_qH sw!(Akq}Pn$=ᨱ`*-9@;4qˇ*IԽe:,׃J{Y".^I%rtSٷ4`E94ǔ5ӆJ8U}dCX%r#[tF9\Q1Ytt˩\ks\swQqy-ݰ~氃QeEX(";s/&]Fr`]~bcsɹt$~ba)x @Yq4#U.QUeadXB_i#",W"TgYRqTK~(pSeyW$"_*M-g#QC樒ć2g 6C^^Z{܈єEl:EI;ÆWyp IX3SaH69H=oi)բ6VۣZzy0 PA2r* Cc=??qRg&?r%UfE7$c㉾=(!o ƴٔr1$l*/p\\};)]_ѓ8 w~15_kEH0Io\T};)L m Ċ/;h!(9Z†8x Q1B}4t[ iat"I9U{*̑NK{*>5H˃rDŽ8ʼnL\W=bSP%`ʫ&sG l89GUt03ЖΦ>C?YQN߼ı꤂VIؔ ,gC` R}d)l-`O?8nwT`Y1 ~ 氋j7+D񓵁Ea/ʅW*kXBEե!1m@Bh18Ki3~dMPtoֺOn ;J6JTʲ`+ε~NG%v\ ju '%jj Tk^2caqc*w ұm#<~)#»4)[eWai35XЭe\YKC<( .89oix_nz5ANކ8'ҐPKڤl“m1j sKkx h!vLʅOE` bTQ.qcSNm$l?] 8́y2xtESbi#=q":|p1h0 H̜ )&MyN:at ޣ% xp\ySX\y#CTw'uH.l*0*4lAZ!̾*llI)k0n8<((aޱ4]=>ENL!eEnf.S!h32ք(3N<S-dc/G~Vf"$ЯZ [؞ [Zk 4~ބΈ2k8h #* k0nY?)) dmQB5hi.Y(6!Ĺ^@װ%Y&5>T딆Ziչ95ǡӈC7_lJLV\RW3kcdS:'|p{H1m@KHz`NK=. j)'`&D`D2 \N25Sm`|ETDZMcf ;%'5܌ޔzry@:또kCAKk0 m Ȁa&#{:- ^(u*,vy%P$ڰ(IUXrp Kˆ-nďEXrC)xAo,fOӠ ;ct?I9$!qaCq(k~{a{i q0"fmq JTF=v8JZ$-qWQX#D$\EvFZ^i*화絛abVR&q\sk00Y4DAPӈ#Z,CoASiO7ߧ%nLퟟM9P8bw( '@8x/ 8h:?1PU(`n|s1PTun Ÿ3C) W^^Xl9 5PXD]UFأ.xLJdxS#qHȅ䘖xKASQIav ɍXEq;$a7Ґ67: Toj3N.vئ) ]{k$oV}kHLbpQA&{!75'+;'[ T튦nt Id]ԐENˬڤLT׈O'a'= Maw-4 BnĘ5RGϊӆjj[Cm~H=ꏂNTeMAhmpw0F?_w0ǍT`&Do4OC n,&,oHN,\JW, #AYS.}ӄpHȉNsXS Sb_VƺO*T}Tl&3 AR1-@Rܽ a@4Y!pY4ڰpR';7V,*C88NIX1m@_n [16%a[5 IiH?Lã.6竇=8*[auzRb7=)(ttAAxQs:rjT:E'u $FR!PO6cZ)臙 l89_CPmk q'%6[d0{ɢ1,r`kƓ'>Z{^-=ޤ\'[ ;"G#lbҭk>xh JEZyj8um̻^#889xO)-擑N:]ԗ~&y[9᰸ů \HX#5sPHѢIY8l3>{ ^h0LPF.PvyVk f+6( !ȃNK{ eAXa\׹Vwaf xb(*岴vbʾ9#PA  MJ *=6'n~` q\KHp7tKHC ␰気cKflvX 31A@k2= BAb1%jSzxmByY= A>(GR""fCyu0Pٞ3;Hay ~ 搇@;ظ 6',Hژ!LX NVۓnb)`m"ť氏QHȐDyAǁzf75cGq28+A8Ĕl 1Is:,,LM>)H[n(WĈcϗUk1QTO΃#%o c; 8ν %uJR*]Z?b t" ~b1Uc x#ݕ=Xw75Jx`N|$k rl`[Cbڀ(ˣ=lqPcT̚6#.djvc9=iH|0' L  95FRP5߻)qu#6 Z^Fc̦ᕖ6*)Q3 ZA-cCZ{҃洈?;qrT7ڮu>8NKPR]mR.RqT Nn-4LAFYzZ1gߣp{D|GmP CnN~(q#FՇzA-PxxR&&[9 & Ǡf7| )¨y@f]sGt J*~Pw+ -o'̑^Kk*6~5TWѧ"^؆Q#~u0`L!aJ5D҇ @XCKF`#OIa9Y,ߜ($̡jV`Xfg4H! .Z{x^*U*52`8ߚVe>Rj.,i i0*'):12m#␓VDFmʍDF\#[bERBjҙ/U ڔi iMec"V(rSX.E=h3r@Uu0Gl aѻ&)Q2zRp"jh F0}(w0j=4&eFhP8HƬ= ıu[B|P;xqax8mvkۚͪ ~(Bcך㴄4k!]w@wKtv#P|˰'AaײI8gWKXvPm`L}ζ bT둄9oix#/yŗVF/v vĺ\49!q6\s'_.W^.Þr!v#0λTEg`PG(k Lv%FE}2T Pސ/ʴ+v6@R Z{ ƕ3>H|'sCl*\ ۦ0_wk8PW-M*}0}(1,YL3e4VG=;BYc,|-!Mc@̐(f6kh)᛽08t>#K7F h 1Y u8烡Z@ /u>V&TsG)3 - qx}RQ'&*5:5+fO. kH\U1)Cm^^Z{\4|ęILu<џ`08<v$ل>a]0G:- A("}P"G5!HK8#PRԨps2DR$66EdRC*/tsEJ=fx,Aʌ`,M,!/"{n±!/~KßqdSeM#8)IU=;&Qm\:HxJ?(߇%at='{a[`mi2B/)45rc$!JymJG$a}95ǡ6K#.뒂>GzGŠ8c>4$JJ i!¢VQBqsgɿZ3C)"^C%lΓ5_W?51U#-! mk`{a{i qdC oHʈXhBo~EfGR zv+2- ]3hov˂oǹK`֥Ix:ʌH`-3b i8&7M̐^K{ w8p+#)7 V7x` 5~Dds35M% hַ aD`9oixC/<:C9LBCB;hSӡlέ.eXCm1d0}(<ĻP(ߢ!Łݵω~6 j4)oKC$L"VJafH= =igsrm)hpCsUzue+>͍T`L0'ᔄmQfH= UJv3R°|tBDR8_8&;C8Y&5FH$EҀ׹m~ҋH=,'I^w>ǖQgg剐9NIH,|~,SRAg&??DrK*%rr:YP0ěЇ qU¤LL $d ޣP`ܜJ0אYtZbSPgiHLXP56uƂE4E, 9#6ebdʉgg6;k8{27ނT vQ"XQ)NY}ΧƢp+&bdAv'ۚ c# sl}k0 H [) F0G- qx!Vx30T $\W gxU=@+8"ڿ-lO[v-氇#/Ob:grH鎞sewK5$0DdAay!RCn[`⃂݇:X{ XwCG5$>ַ(?lP..B= u=زzS` UÔ+(8]BAiCiQ]9m mpC{a[Y f?y(¤̭(Mz,\"H1,PHg?ܭGr/s|V~S?n`UksL d*'a]-R)򑲦tS" ! Y+N'P|pD B2R ~m/H('LΈܽ 3%iZ@GzhזӾ9YĴPH5TM%i sKkxC)77"UXQҠJ'1-#= ?+RJ1IQ3a@܁88[)Il|~6eSCZY6??ErokxCulq$m ZtT-ly3 :GpjSa Ue )_j(짘6CB^$L qi6)>sUd_"J։,:$yj+J&CB* a=)>}"57fw}+Z >(3yG%UMJ Q6oNnqH/8Gy&]R$Ŏ,ՄȌC2T X1M|~KHCX6A>!(wۯl_}XO7Kq`f؋U֒㒄5$N@V%`ğ95FJDzLhg_] %q4t_?qsx_is],! ǩ , zLH=,$G|%LNáђP! JI˪m-!7]{ ԱtSfga bQa_-ᇭ[}0D9{+H|uXeع1l(ԉca.La͒JczE'7hc^'LH #mĩ ğ95qU01)'ӝ>saEXɳw{pD x裂b%aʞH=NRNLܔP k]ndX_ [ܘ#LJDՇ+kaD Ӄ8-A!h&|0"#GGBԐDPb̆ٯQ钅EU&qǛ˱MbF,~.%êt⒔@+^YrXX;ƭ}ĦC; ޣ|N&;Rzڋu4+DaS{$`l)y-$dACs+OXœM@WaQxq{+<: qaڦT>zVPH2 *wg Y7?GZ}zxE"<zvQW'[B1ur ^;h4" xNax b1 F n#XQNH=:;)wSE*f8 *':؄0Bq9Gi3 _?D,Y|+کK(wK\/ZbZ>6QX??Arekx CsMAxJM>IqSf&Dop*{`;h!`5"r*) Z\ڮ$$EqI)X ik$LfkNOA>?X!ɉ>( #>1>hEZP'OJ[ʃcZBiC1\j()QB͍$]ӕۍ -4AԦ 樖c S"7n!>Z{((t U05 5aj|m;Χ0yR iڢL۷H#-{}CDPEMǃ%C/ ??{PoӅ7ԇ5Ӆ3RF5G((j%\TUV0 2ǐ5ӆN\*NE1& sbJYgu$sjaġf`L!a+P4L6Kf\K^Z{^̓71~§ѫ8xzqƳaRY5IF0081|Bn蟢b^SBQͧ<45 mpSAGm4vv^P>mD}JU3f[(w>6ic"*S$a vL[4A# NJ{*WN,IxP.dc>ڬ! h׃fuT؅RS6fVrɺso`S.%6UCjHиU.&eX4t.|kJ}M)nJ+3kMgI$Qo PS- O qj*!ܔ2Y bQ Tl!3qژKp J8 s,ȑiC(!  95] s4 S >Gnoс̉Q\䈚Jl i󓔨0%խ!h6a9.KPßqըÝߢRhȠp>*߬K`_Ma_jh/`za[آ_3Ȳ IdgUzQH$ƉR1@1<mn3L/U Z\Sܯ UlcRErJ5 :6qM'`= ~kLDh雅D󧵊PS=bYBX1m^=-ୡJ6?? sKkxC}:kOVG~>v˓,??NqDu O@ŷڃCAEY(Þ.w;ht),(; +noщ !պ.v~xltXQ|h0T@< < &냧 95FwaC8|a$=gf5CQxJSC⪊1I)/5 ␰気O_42vLJ)XLkH5 uLJ,)ˌ%yfbYoi i0 u{i,* AnJ^Z{Ji?Cs*p}Q`NQÈV>?24[b$լ(x+6l)k[Ћ_TX7u=8by>,m@mM$~@$C+o]]K3޴0#%O16 X>CR)ф — vp~.A!|p ] GV^d̽vEH6{|B菳Icoo(UPe^?~yʢe76er>t\ݸG+1%J#Zn5l|xʔSlNNxT&RC6MO}P.l#vP;.+1`,!5-6PLʌҠ:qi#+ɥ気Zb CwSoT׽V6P#u<W{( b (%C@>$Gz-Qpd%MA2u= Vx+K(d_7o:E۔N˷h:J{ P,?'It[B~&31oYu89d:5$>N#ԫROr157| N޽al]|k"m~ҋ>b =+?  Tw}TNU+,J'o TQ i_P L..S5QdFIam9Tm%yĊQ8=4%DiZM18Ki339uȩݞ-ri-1, ִ-CIJTJ*8 ᐐqXBޣP)`o}2eb<d*Y;Lk>v!$! g%RCM J気Buv`}P z(Z'72]%hL`UQSV-RZN׿`97]~ CEt8"qA\xI16, 8Dҏ-9.qK:J!]C@$]&1 Vj$$sY\5T[|vjMiF S5Ea-ξ[;g7Y) QZoʅȋ\3ʶj>Iƪ stn 3)\6k niH\7eZBNt6/a/=啢N'& zWuێ7RUo>. ^AF|C[W=irz1?E_B454${ NXҰJCc*tTAqDYs8/X8~&wH4iBE. 0- 04,(:$ň4; q 'Rf)]1!Gl1`R׍b*y;2$2DY'!L5<Ü]5c#. Xb7Ґ&|Z0Mgn) >ep^e3~85Eh& 61H}RVDG]k0j?p\F떂c*xE%_UY#1Ǽa"ƗtnkHd`>!$RZ4:%-5FьI87vom㩅6>(sh;п9R Kf^_( 8FxB*\aɉO<*JgtaYE4vT֐D/|ڂiJ* [9>HcK(,(m:wV >8{:}k/i(9[`>63O´O 9QX"㖅:=ukk7ZlDc/)xXin caI>H:Jr'7 i&ҌkC_xac }Yh ~8 Ek\-8 3PtJZ-$/qRp69H~2 d2^9bw4Bi%#cGB}Ưc\a|WOm4 \$ H!1`|ڜl5[wɉM-xp2s؝dQwe,Х`\ .KPp Ȩe kq0Rd|=bF^ ظo>L_ʼnW)5` 3Rk s~5u$gcF D<~Q>v(|b[30831&2 |@?R p6^W6xA{`sЁcG8J%H.@I?? Wzx> ȌjAȢ gHA4t5940.p5cC{ :AH Q<9/H%ϣ=ԓ@dvZ 7G0-ӟp$4l5ƹXfQTwwY~! $} aόiq m9 @;>kvfhR}rTWܹc`h |{&~4Qv͇8Ӏcq,Tii ( K8J[x&y">7̨hQI4"^Nq,ɸ8%!4m ^ Pd8*S$\;H-GDbS48Gi Y0M'2K vAVpP Rޫʔ.h~aMALd',u?g|Jh{Z0M3 ,xݴ(Tp^G(6:aGUaՍȔ֐9XRR$2H ޮo^fᘺ'g֣hŝaYIdyf;%J}<,>?5dw^uGnsȸevYƋ@@blm6A*@F9OKtrsX^Jgo\;]M`a1jaSSlS[A_cڌ?dEP`Z{:4y'HE4b90/gR!ShECXU`0hᏫʚ4ʁ!c4}|~gnXҰC( K8J[x|Era>S3vSWmLlG~R ǂi9K - $E,$hcDrNJgREfp"J|&&q']Yt8S[OCX{ 旼'r?hxA.Hc/ KWI Z>t0 -M4C'H[иb(&b P3:F9 EUM8H`>p2(EBO Ù5$(m ʱ过4K-ov_i/Xtİ $VNE?.<%a h%0A.OSB alI"!_I0mХ7PIgzȢό'j {C qpnmR_}?*]pQ'8QXQ{y`]r Fn޸, Ⱥ֕S0Ms!'c!/uC!S2j&fl6hޗwǑҰ/ENuX}H2K8D[xsx[+$)O tkBL?\TbE$ʃӊflנG'ZM -Փ.*4pݤ`  ̛gs$B9;6 `DM 6`.PhnNEϯ+A5VW` 5.5!\#qDyS (?gQOZdɈRg6~U.tE` Gh %`rx᠑9n4%Gcj%i )N-Tc'\pZV8koNjƔ{˰y?%n)H@MDz_Bѡ ChL#{΃CxFrDNA=Cݣ=$/d!i990%>wV/[w<4P%6NX$F?VqmBEAU{ ~#1p{H`N v'dHOƓ>8ҐoTƐH~N Ș^P bN)mm@|"$Ia4]|~NlmJAHzQ50;:g8Ԝ] NT[ͤ#s-/x7ItgJb&&b#ԣS;fڪ/۪ Xa{h74:e#Bj8挴WQbCCQ:4Gg*2~ȍNCu|[T?Q9hҰzFs*iH>HZȸe*Ylp|FDU+Do^H5Ҩ;H֐ q&-4iωPWDތe2ǭAtOg#k3E 2phMw|DO;vBD(5$V`*=FdPP RIVG IČ`:)96e4GqyRFa Gi uhx2R惛Eq{^fǩ=6VfBz,FBKr*laao W= ̰8/90RCj-Pԅ84,9\Ґ}u.}Q:S*1u£F+y!;+%D-$} 9 /caڧ|JP6ZpfTm|pXnl:諸a 7 I"n:]ue0Y>HQQXQ{H\9Yd8I F%Y4AN А¡O9^o;Ѹ|f)k3g G(P|i8YH| &V4oTEzkDD`>#NMY ||Fw:t1)-NwN=8W]F$'!i:͊9(I{L㛫%2hYx/B[}>ϞHQg)F4,7;m!i?.cᒆ}\~"fp^31eT9Odz;%ꎂi2~S|稛xpPr кg,}0&sͨK`@rvU. fﱭql^JD,0')1i=\! BpT(EagəR[.ȹ6[#-y:S7T. {w0gRqlSC|qs{2ɸ龬@( $MJ*F C* 8F DLN 9qԳ5 i#I7GpBKұVp2g8,ʒɞX*O!p?$4l!4iBAKiXQ{|x|wYx]HB_隒$~V@J3D6|7=가 p]"sb8Z*psWe'bx$`_#؍04Op*?EDe p6^M⵲Ay!sPqt=iUT2y) 8>v9Yr5dSUQXQ{BUD2s\5|q+[ 6ts&0pm4ѡRB1*}\.N+g>88}<[ы'﮺~5B Qb_3Ck6 i hO008dQYnBnӁ98!|%ci*cO7p@Oi0MéҐ(~y8@;@kG&H!Na=<*WO[ iXܬC 3[AU]4a $A{U5p53u7qz`>g٦, L5$(m FA&.ӻ$Poˀi81&Y<FB"s7ojVONl޶㓭1y$!Z5$16s`>>?S! 7}?|(,(mn;1{dl р(z#!8KLiB?wQ:h6pI.H?@RAkb-Y:^bxxz쪿4Df0Ut49Q>%P}4˷ގ_HeiN?W|4m p~V$ lk(tA_B clxiq{:w?@T]o&q~ܕUiys:XKgP|Ocfr}%]"A pP/CЕL0X()U(,(m@w>Y9HYlAsm_4aع_\H %{\hAgR/ y{*ͦ144^zӟ3&GFUezZ^m1Pv ht$-Vڣ+nrbw■ܼdUIJ, hC%j, '#kHA"{+HP`ehIA1ph F<+E@u\?bH(]j >-:ie H>gQ7M;#YPXa )1{ J(w&=vN_9K/Ģ`T+Ȁi}99 qQUeJ8F :ZPTJZ/ZLת*X2T)$4l!PzSa mq(,(mՌ݄e$I0J~gUbŬ3NI KliBҗ3lSx'u|Da Gi u`b<*/#FSv&g /CL$4. Ry30I8ALe!9fx@G>p$ nY̳h=wHD}yX0Mh4Pti!3Аѡ(R"㖅:u伃q<&$֕S磺eKghT`m Y0L:>>?QXQ{<ɺ_po([>]`bh^wFy66K98כd2^BX I&پ.VdکE]FUg6 I׊=ROi4G 2 Y5X_Oa,4j'C;iTQ[6teqv2p@ꎄ"snzl&'J5L=Zm&cҰEk…Da[ y{vCzGA5$vrTZl9묏i:΢ \wFNKX{ J?@ ѭԊ¬4R?PH##yK8D۩mǃMq7o3;鸦 G D!zHZ;֠Ƣ\*1X1{ [w3[1+кoi_!q[CL%߄괁. ^yp8c %k3}ʹأBD3o[sh?hF5۠,tLR~{|&^o3'R pg"#x^>$4lrpQ21pAҰD- u{Q{Q`d+'+vC[c29^iۧ|,Ma>hlB^u QZI}^)me;/}GH֋;'8dl9Fkdv""#h% [H[4[M}3a Gi uG61?-&'ZF}utȀ(8dA$7C6`.!=ı!$QQ p6^TFVs8u0r4#MD0$XCbBL@4lZL?wRWgwQUd8 \veу!?e$0"èh=좸 0( AŸUߪ+P4p ,/dQ7&(IFM7qB;'CFX;~HgN= &4Sq& #8%ZC`ǂi smB $A;D0i7sK`WjxBAI{laeـisڭ2h(%bc*,:"2>q2a@>6!~4 oYZEUI㥯,m&kwsS[5j6XўM!Z΍sJ2Ф`Q!\I1{Yx>8;--j FTi5i]Ch֤ $MD10TD}B%0y-5&6J H@%%FO@ ɑ v܏ qS)Q+*Yq-栜rqi~,HVA% LIh0 1H"c?P0[x}p:(_ Q RI|FJG4w=4th8#{\'q$؁gqRt5!%e ZHzp5d!z.Ǡ,V.lꄛB\Kh=<QXBx*ZH>"Xyi\ZD- uҙi*ugwXT< }ugzg@\CgXZ;;lw`:q,܋@2:퍩]=Te3'i Y0=NN܋.pƠߋeИ3}p rF+ΩLZI)֐D|WÂˣA Ȉ55ƣő֐:TҼyS1=mk x|wV/;vm@ޅ߀6AB}OC|XH1mRkEryE>7Os"R9 b(T34:4ҰD`<e*Ұ+&:A(Cp.%RrW ITRl9M_*Bzp03c t,g]:ƎrG olJ](XKmm=L0$n#%'r@:&Bz/B QvO1}8߽S5oJ˟WIKY$+鍂VS;sE~^NϣWJpJX@cN#xu;s1iKti؂iφ|pP)z,8VJ, 3VٿNgl\ŨIc'AD[H:SmSt|`nGa Gi uU~ v^fe׭O8unI"NPg6q,ChQpw2xY`3@ݚl<u$/"[?9 x)H{ |Ef>iĉ!;NGfnDNc1lP?JPF$2DYUp4n[Gğ!ڕ (8:>Xa-Ӵ qsʿ]cKY3oșH i yW6[A$VQ, ft .]߸TAXA{| \T7A$'"CY^CuJ!.iطw֠9j2P.H#o I8F[xB(8DfD1ͤ4%* [HZs٦"v Idg:xas6'%QawO.)X":1dVr 7۬살Z%-Wk sh9 'i "H{O&<%flK=*q8p6^P'b$ӡi`4:'^@4W1iHo!-$](·u\@p^˫u5m'Y_z~ŐDÓm I|72قi8QWPax:^ST"?%7Y}FƦ6Z!DC`.a5d`7u|a?(,eϢTQu͹js/ݨhsU߮1V$Onۂx, 844%-1Uߍ4or\EeFi!RbKen'Se!KOQ(D- u [w84_zqp]k񰴴M/5NaYxO3K8@x/AgKU8$s̫^i]yc JkԔh_BiqAZO`VHAUn>Pzr:Υ|5*t\ | (x֐T۔Qi??' K8J[xCL2Uږh)[hz2S\oںez^h_}ҟ刬oŗ$_zoq@as߫m Illz\וҀRpX-'8hc;Y]zR_ C'$C ,sg (Aw0QGQ{*QU$V.4*t]yD%0tU.19`,D4BZkhUEbVL }(EėK/MZbK|5h K=~|ta(,(m>wW)RerFo ۽4X!q+پ8"QxDM ֡TN~%u&yȪs!ӓ}g/l! я(RA")L]>8G ϸZI#U0Hx"·IuKCb<.H"SBL"eƏќ8| :48Hb5OȢd2v/iХ h%(V<&*}e !5;۬pjISJYqYA9.k*x{D<#`#9huvf׶ήҫu/ӭŜ8 T{rH-ޫΣh.A(b½VNs<[g~#o& KʶS[HɩҰTw%e0QXQ{<TvsjOm^xa8E8:Im=qO<ߊyǡUVP@\KFutLxiIۭ<>n3+Pn>?ӬIokf)1?+Pю4l7\Ih"A@ YH>b4D-LN,O33 Kdܲ^].7Ĵ6~!+jtCIC5~ocE_pVp6^oܑgY ej6raB}Ł`z?49Ccd>$nC!X!B= PZ_[/ՎPy0at~3lR֧)' (D뿖i3H-UR`,*Hd^ڲKarC n<@URɹl(RAt((P-Au])Tɉ)䀻0h1i_g=e IlH iҰyzFa Gi u V;3nۜoR?"B{:klbJZXiK' K8JY?W2+p@~b 8B4xhd- ?dIuF I(jx-ڸ d’qhc톹uI"L)X4dК|81b1._: d>=`%c<;ŮEN}gAJKĝ8& ̩R ZJkl߁h_l1qX[],1,.QIn߬Cm Y0Ma;Z!  RKخ|9/o8^:y,zFv%^ ˂KOB Jj ylC4@Ag ,i2N` h E|]jk -9MZsձ >d[!:،""_gftFztMW9!X!{cO  &kYjĐ-$-̍Ù) q>H:xvK-f'2\PLZ[DzDstt'apAZ B,YКgw`sNrV#,^brx+{>$|>L*ʼnX (V 91~ W|z#)ߔ`>a5d!th8 Kdܲ^S;97\¢7j]7u<$5d4}@Ca Y@%sh"3">b~;^e`lg'ewH,#BҗusVTNr+HA/ JQ{ߨ O>i)As({#{ |:"X?fc$v g~/@9*1࠰6G:O1??/$!LjsC$*\l!k9>DK5KCnMx,Q4v@ 8+,e] Ő;*'X8[-fKFKbcЖi ^9MlG(ȅh! d2^{rR^/JàwMmh %n¡/7Sa 7M*?q7g55qFHÙK< Ȁi80i .3`hUhū۩}dJVU; t.iHwX8tI˜Bcaʧ}(,(e:*B0˦gs36lՕZo .&kf-ӧٜf>-v߁.qor0p3u3Ǝ vaԥzдm mPg[OH38![,B(=:k@ȭm'*~?$'.=2'RIH !X!BnG_Sc).Y،YDǟ4n!}=A:q#o&A+V9]F(spg¨N` 9P3*F ԭPkv͇|O* >d p6^ oFevD6^>O Qc,$]웜 )]hȇhM0P6Z-Z  nu*R)Փ8?L hiFUoU⋎aAѣ\!!P BmX"ŽA4RĉⵅD3XFz8jxݛ43)^%MY*ki~ ޫЬa&5W4 Dg.@EiXC:^w%I?cŢe'hiO*)Zj/XNu|ഁ./gݘ$4l4}AۜSlavkω,!VU7`GGnF`ȕHGjLNeK 1m`hUbUvDA%>"QErKיP7 7`*rpq"D, %hOthjrHeV؍I4~ђM('yp. '4 2A~^یZaz/ll5ȸ,V|?Xr 3Ad{?<` hU$`vۯ o-ЄP929jجch[F X4kBҟ%-בXC3emq@l挜]h]HZXlXHx*IXSť>Ϡ^95Ss/ũǛٿґъYe&FVX"24]<ueAAX *4s,98E`U{0V9wՖ֐/Jq5`mLqGq{ڜ ߋ!Ex  8K0pȢ'Hrc*6םgRs j5H]rntO[e 'y>oƢH=HrOpg} h EUvqM/#3TN/$a\%HҥVrp Jue"??" WžH&ˍY(`WS*'Դ}=EpˍM$-LJhg8,Yt`nK0 Qё "{%E4u8{ӇA4CJ(DYΑS!9rC[ם`SO.VƻMCd4}9iaI>Hc(,(m6KP[Ỉv/uפ?g{J& -465=/$??g~/_Ķpwp@@jwO]h$.?/IZq1I9U:鯼K ApbxɅN6m̼iq`1 Z.aN\ QR { q͋?j3`I?HNA8  PK`kd2Xu",> 1#1aAt79&lZ0[Q{VVE{^ɉoo=v9096WI;SkHPzIy$cK\ꑥ$pж^6Rwp+F ;.T{!za4}B}VQHM A$ȆYh䬁Gk#E|Oҟ,LNYbHL4̉c`p3.wk%2lxAL8!3eF/(nq}j I-`iJ2db@qQ5a i U,irq8x.{ UO ,E]S-$j1X$qV]=@;xB`sKZ&6j(JF_~oEp]ąbrn&Qyt.kP"R_xB q5da4Z%,YEI)Zb&W,?pYVi] C.7tX\+TA օAα=:9zkڊa:fjÑ֐&oq4l gkHQ{0NN+NK}H_!TIҰHGߏe,Õ;|uLqwW\ám;Wұ0Hi¡n2؛.[3Id^o6[Csl~UT2p;!54QD "%-סKJw_8=.k6Np $p }8?4죨K9c*ծ:=O!9 "1DօTp'*$gXv)#2F r04cS J 0,kCDˇx)# |V*:*- up{ʑ(QѶ8UCЎS;+'/N 5dA|`/ζMZ([E!|kHq{ǐ^M;=iUHɉ)Tz.FGk{ JUu zjͩH%Hy(iUrQVLӅJʠa ߝ~{ LvG9Ӝ׭Ha5dDW~H,;͜`8$9_j[h9wjѶ$^c@\Rk%} ޫþ/6" 1eB C'6'̸X"@җ  8=E[T p6Z =ĸ2X!7Q}'<5cbRL4XZZXZ ,"4ߣ$fbN`r,hqk m4}< @E”} Ga[Ps fEUr6.E&t%4l!"t۔j??' Idgj52"9{fMf|bL"ξ]l[`zh@ރsq-tiGFqȸeUӂZ)C! .7(,q{ǃo}3KS13(# 0*HcVLӅ ͞[4jhUրϭNaO=8NiX"28a4}|~B U[ҰwA(,q{l>nTyDr66˙%S$c-qSd_ էA; d2^_k<6|3}|Umn Ehf#W4$U0IR54%2h^VSK`qsXs[gs=0őȋԐDCՇWuѴ8P`Zw4Cth(֐:pJ-39͡)Vk4. He8mQ@3}妝&d1Rr /M7F5([SbYCL*TɉJB$!??EJ(ʴ^s;I,KV&x(;sAOi@ l^X?&CrƔ!D Hpfs^h1ӴsfS}%-cMSfq*$N'xonM4Ér8bEJA+R-aq-Cz,.n ;YKAoeEa[K`a^phOT*Jkic CcDSpd\bzNHV} ދf添[x M\L:~.{G4l!i s ol]a )U[x)_=nj2ߍ8zO4ID8JF82gv!¸r$6ʑ:t%}@o'g׫_h}jkzUA#hH%%&$"J΅!1i @YqD3X`IV&gI*ca h UJ0Wa]I?YS[4rLK4KDz 7:X#vfqcYC\HF.6̌2qҸ%ґ8 Z>tu1F|!QD- uipw'Uݛ3T=7CnDr,(,!7ݪ-|=|v,סY s#-I ' 5f+{FIAh2 K8J[xCb7 U,f,T r QʕJJ s86eamωBRދPFjiUfFcSIY@aݺ0`93'ÉPKP}z[uH;ۚˬ:e l"yp*fApi 91X1Kfd'ȭ50 A<cCh4 IEt2pKpɉ&DdI>H# c Y W6Ysn6TQlG#R,8$c*d,񠑂 N1ٱs8_cuC_/^036 $`>Y. t x[ARޫy ` ݌]i-.3:<;0tlNƙz I4Yܳ<ɇx?3#i=87's6vC㓅?+`5Gv'^9iؠj:#GmxMKtkȂi@ѹ8i>Ae#7p^G *\žR D1&;‘)Q }⢻1' )q⣁? P,wF1>/SKii1%fJFAQ$o Np^.]ܨ=y H4+PMRdӀHy@8&oؓ Ȃޫw!-tm ;&j{ r'⽑d֔dcaᕞ.$1UVsZyL S<[ܑ(y$ ;ӂi9h_H+ k[H t\T${Q &@ Ⴅ B!z.!Z D- upqO AagWiZF(‰HT I_*Hΐ-t CQH"?%ƨ;Yq.‹kK kȂ֐ӝ??' K8J[xk,~n^@8K&jҸ)s <#!  NN >cxMFaE 0Z+!nbyRќ'mD5kD/{ldj Y0MaN-|=|F5(QŸu6^֖nQV&&^0 4+Ȁj<i7$kVc*^Ɓ\lZF1v̧r9F9-$M);BO(~dp^js*m9flE 7?{Fm5RXCV'Q<[җJE~wJ86[xO|l#Zc(7ԗľ/l CF,\PtCK8Hdܲ^.55'iAփtzҸDq L%É֯<33dZ5p]#N[6# k+/RJ0 #@.MΥM \v(u|퇄C x379 &FG~[9j߳ęQq j+][Y:K֐pU+@0MA.Dg I(ȴZϛqz <b|C vdhH{ұ`p.۔p}\j$8QH"?`s0 L`!N%ȅMxKuj Ұyci8aJ&|zn3.5xH N I7#u&* 9AH"?$śE0j#k#-"5$QFȂ#I{FBD( 66gu-9kߖvEC3:64 Ko﬇xt6'p{u U0xc^vj5$d"AwڳAOGދ @<.L䴂C4Ǘý0t@5$]:/ s811P`??'K8HxBhu5Xq#Xq](9ar,ۜҰRa- dVͨʋK DF- UbA1'W{|ZbIb#ѧsd4}cPQ%2nYxC{$.nUD_PUyO~ƞ~j-,DdmљDcC,QŔGm:}p:; &_w%Un?|pa tQy-"ROQtT>$R_zqN#c {D:Fmz"hH%-poe+?޷fx[΀Dԇ۸o# Z@va:4őȸeoAd-9 %ܺ-JZ{~H4=mmΰMY n|^:sFb]%9+`Zo^$zl|8ْ%\i 9H.a%2nYxCſ|*g# (^ @oYECdq%/$C~-ly}ؗVD@1ބ f&PNSa?cZ'aJ74\|~ '5\ʅO,VZߧ@e28Ez撱=FCZԐDÂiݱ0aӥ%-ס*tc3,PMIGHAL4̹k ]DH 19j l`ĉ-VəlfG/DwwHlοI [[cK>[2 Kdܲ^~{䬯٦;aw7Oavve(AZ1i[jWNrn g SF# MwNSU>HICG-$M)c0&Ae, ۆ4(ϜikQaѷx )X"PÀi9) +GQyaZޫЕ'18";98 D+xĒ-n* 9v)Ǔ%2jYxX਩*@*U=Q!%:b,TNB_Ґn W1'| zpxBz`Έ+M =.0g)-> KRخ:N2 毣9[ćswK4Vn+Na~g5g\KsGP~[V?{~C^;9V92NI>)X w{x0&˳cKQ1M)I)PߤM%V5xjpⓁ}k}ſ7C lS`E֢})1XX0ݍU MьQXQ{G  nq1nfkTn4Ұ я+H̉{}t,´O.m($QŸuhҨ#y~HfaGx"詙4+ G"zBEh&f4n4~ ^;2񅨷.%' 0񜫘p'ܽ) [0Mjf bDZ( Kdܲ^aFCUW'(*_5#o: sD+3طhnd}`dG&,8 mea#NvlFgQcahE\"+ ~*!]N Ov$U (b >SH XXlIbF'M PcahL 보l'r`xpcTqޤSI!+Su['%NyjČZ9TVK;zh C{,|ꘘꣶ NF%ϞDа S~KLnoR4! Ogak,:/1+:3F+mO _hST$_Т،ܕ_(2WW[(##%YbL7FYcZLJñuv`Y`: cIrA'0E- q :!OlV xEDQؠ>wD'ĺP3"" VT毢pSbX su\+2(=~_P֢@k/GW*)[`4Y.Cx XOLr 8xa Ã0Zt>*K+LvKu/^q_F񗈭013/ &3HaoO.`Fj!M0Mu q+.ԅUPG3 136wL kx %G~N~{6ZVe0$fBO7XlѪv:-\"O 0rA󎢷h ̀fSp/;U"zl񣐘#u՚ cIhQ̅K0LX 3&6zI+La+-:$mrw-^bSᤚ#ՊS~Y9X\0 N >.X@Za,Je)l%\Gz-EF;Io۬m[Dy!CRDU$!L搄ѽeᑖpNj;UD ߍwj>FβtE):l&Ao3i/`ީ~93%sHL# EWIE d;xO`.,S_ARApuLVKu:F3ʦ1G?qt< |E82fI0I0ܑ519$aEgAXvp[,1r|XRs$'W'@X 3eO 㩐 }l}TE !S2p\ZXa!kr$űG8% l P ُR!i$\F"Rc>_k Y"gI@jG*rX+ ` h A\^Ny'Θ:c}Dzq7V8LѸ K EcX.%L)q4/+LvKu*T5"̮11=a|kSMX+y9Qlΰ%pSY! beun~f-|$IRfP1tS&BٷfLy^s Qn>+\\'&H~ǽ1c9̈GsC5Bw Saw4&""08A0BlMg؊bk&}3 h>,ik;& %$Lf4$Dg夃0^_sVJ³qH ̕"]722P cvj}Zn2a1uѱw  -H h &% OEݹBVƷ1˘6OU!xو$p+t:ftTmS? DA(^}f{ M.$xjC7Zq_؄` 5Ls`C|w-`FXϡ(慻6 0h):h;tg4lrFPXɤL/y82f}KH;3@0:08^Yq7q8VM ढ़Өs\E1C R<*Ơ]pl|RA88l)l\sׅy0' ֖h9*|oE u0lSN7cQ&I$+C0Ґa [i q (sE#2w<v;VVBRaskL.XtWUI+DVSu|uzQĔqgl g.KD9ahrڍj1QBԡ`:8S`Axu+La+%8^9)LܘzB y7!VL DDʤn=⮫%_ l'g|:qz'uXLtfMEy岟:`D SN\Rl@h` h\6)^EhɄwmj'ucea0⠀5/]6$me:F:h}p++}KO KqV;b]" rK GzSDÝ 0H #QR}B) h` h A􃶙5sVF<07H')mEyVd`nt$׌)zu̺3{8I:APR8Ko<Ɔ/y։)hwt|aǞ|)A|g=:"l@*7^ o?b_hQY 'pbDcu`Xjg`1Uf:Hq i)l%\G* t >()!u‘ljLO&AJ9]+夊-pKɱtgBk +CCVc 2 1ce, PT1jԍ H GilYuP6ܼh@p3銄NJ9I0)BXSF.Ӊ`4$<:#.1ERC Q4 }Izb6f!#PUqDȅdĽy"`ʸ1` (N'@j9x!s|&yZIXчK0L0z Xf> `#LfSuy2)!3W)$u:QTqXaAwU1,aN np"햄8^pQt Ó#<'$M5f^P̞ Ŵ-_6k %\'[ 8F6 Ef<]RLgItOc|6ע{$[76~JQ_tgOecuSTEC5`N8(ԁ1HY80>|⨲*_#Y0Z GQ(KM{VU-"apL,Nb2=cV`+%&Zu[`t#X^\iMD[Š=,-05췎к3 bŠ2!do: ,bNC\ >= '=RBaVzS VYGVJ+V[%+%8Ԗ&V !yQqi^ꃣ8L`x*%( ;uLYVۭUu c'è 9߈ʰHG.oҠtpIU964RBP#&ɹi)jJfv7G1Bdi8˪`)z"ۉ_X!A}>'ߺ&p«QY)v̪lD>*EVX>Az7$0u췎,!šy. [i q0$rLyLdL_O: eIxKТ)%Ӳ*iYLvA{"햄8T+l58YP"YX F1D-f`\%/]TlO0b5sN9eU`wL+\-lQnJj Y:C SBq9dQ%D0! [i qhF^#j#lEP P`JbG(R5{,<_T(C(υrҢE|+2)"u %!aoUHJ@JN#La#-2WXULZ;Amc6aqRY%T<`@3+p_76N#xad}pxpA? ۿn]`C41\ðFQGL wP+`Vy% ř@-SaPAe}F1Xati\GKZ0r4Ea9l!3UD0A S~똲rj *~66Zu`94u~%hT@ NQA3-h!p-sgLLP 񰩤?u)|:I0L)Č8NH uJald(ݔl,4yn:IuJMaUHUuڣM=i0k ˥CQD=OHAND3 `?QZ6C`cw^iL1g͊_yKQd~K86p-'I`!1) *0EZ- Q贶 PwkS= Ф WK%|aE%"1h%LUŤcʓ [! YLXnlG8Z8+Lش%O(?f}Y~;!FU'bR@X1-0i\a*`L[8ƑSaO'K5 ER,ëC;F!Xt,- Sݒp+ltL\x&Їl@~O_lon: ;% iqZ!SݒpG_Tn f X\?0q(cvG0Par]a 1␄%N]`D St)8^ 9rWD7A7$;lF-%t*(6Y VAX ے#]FqJT)oR2XbJERq:9_ Z}P5 aJG ˡle4ͭacdEƝZ̅gS*$@`¶(fP }l)hI`);3(78ºl;]e)&N)ÃBN)@R0l$u.l.,O{¬U=NOH% EJU'{f;fӮ +SaM ^f7FmW;bIWWI}WU ih[ˊɰΞpo 4phدhqΪ4D*TFi+ؔ2^Z =`c*/.y.`Bb]N:8ZRƘu)nꦸf2) %K sb:ٓaM2Ǧoe0SށcęLpVߘk⤘! cuLUGQK[a [i qR`ADw8̈́4NVzY9Щx(x$\X5ꅅä́pǫi8JbLJD5!y80@$R&js' q.`5'S&&Zu}IrBLLCȶC؆ک , o:<:͘Ñ$Dn*n l<˓O#<yto[6鄍1?0ΥcŒ0|Ij y0%$Y! wVVJ³qR1>MJH OIͺvo"T{[2H %_ O'6Y-ց]0d)l\Gw|!&3=WhTF%a Eޏ' s4f4$ jf*e(l%\Ǒ♈ss`z\eUAYOԱ:f6$[a [i qd)ʑ 5. E ##TNK0\(t 8408tCUCIJ,>ܥF4OY٨9H8C~ÅY0Kuo SJK8Lq!Scx\vC8דg%EE "RPIki]`<փD5K/Ri# \?ūux,tCK΂iЭj*U]V$8^74Y@ӂӒA5Ovw5_ԡU.02%;SuaXOMLA&&4׾ dz}Rl a,0u췎9>cHճA1([a [i qUAcVY@-1u)V>:O&6nQұ:YfӓWaCx%Aۛs9>5UUmmF<A SݒpGo Ϯ#Ɓa ϐ`EoӉ"-' C1㫎I- M]aDa+-:Wp6;N#b|ENcG|('FmsǝĠckGHs%jģՈljܰqV6ٔ})zV׌D[͂ԤGb p26.x9ȪN:.GgDb١B+>#o`+ L`-:UOk6E!qvc0fsWEcHEJLX1p)*cJ#"(T /XKaj[ʟ &$\Tc2@6Ge|8b}onr+:Ѧ){oinq6bgfy[Є"qJt>N~F1G"$.g$\IO~<'tgVNw7oSu;Vb_yc7&2Ҏ׏;J,vwO`T"|aoS0KэTQ[bTu*2B%J3O4E21*z:Yy2덼9i7]];whZ?/^^<c,;\rk1l7kǷoP[!sjۦ޾踱w8mcY??[ϱO?<vda[WP.Hñ}eQO?􂡎 mY,2ᗱ1EO|\ ݷz ?yUB(DWU=o}?Q/{pmpO0?:ŷضhP~XQF0zlWdA~X%N6F\H.X^K?q a?O1P{܊?|ӗ{^=}ywq!bACq^q `(^zxjޓpK!o3W(y~><Ǽ7k^LAo?-V.#^' tbyhr7߼>*NqN?=xvN ?=Yr/|}~]z71/?kc EtUN?q?~&x \ wPS>z)?ц>Kw9,x~Of7ozgϞxa (tܥn]6ԩ$z}x.D9>~GFE]×'zԪ<>_|?.Idgˠ1$^'y9ڟK Q_ =xq/E{|!7n_}M|m"95^}ԏ?:Λܡ̞ ޽; Ckqʰ=_BsiO7ކøno ~<97LIO1I6>Od }o_?={?#Pg?ѧJ>~caWڇ_zkԺ8,_WW𸄃%,ǽ4g5rc.`X"w{Mh?9' ` _]SSD`s,bZ]p^iae!?/W:gWOÑ VsDZOX r?.,m.W9k߾x_>*ۙO_/~ݯʿ>|/ooy ů1 >'bXWǫO~ ?Gua۹9%^XIgXaf\c|월O?~94߾暟}Q\P] sWlzَwY/=䛘tEb03OgxĬ%T|`~/~..f_zТ[[c=^ۆ9kl1ia77, @endstream endobj 517 0 obj << /Filter /FlateDecode /Length 2294 >> stream xXA۸=w)>{EĢ]]ANzӅgkcIo%9o_o%;N% ofx-1f/.]fPSC%0:s({;7v4ۺʈ"Y7{9T\i4LQ$,sEUTe%|ju|w}I+|(v~ڿGlcIj?8Fb=ǹ06ɸeLHsW:!*KJt]p˵/UOM繞q[J1Lc'QrS:cvnc=g>=tWRͽE Eqiώ 79Oq\p:C~N\5U!c٠u!^z\genO(NE,iJ1-N0]&Қù4"7zy .ҵQY|V?`Vx\ןw!@[j8,їl,܊RTz[1vIN+ 0qN P2'.]ߥe E'vk$g2uc&G*QGmCj>G蜇||tٗ}|g?HǚsvgZqK j-XPԱy6:O\˞(u37ذN"=;+3V8!yQcG.MXcE,1+} >(d(LJAHDlύϕc0~3qjwr(..pihI_fc6kC3"7 %+["8əO7šS~jXg49>${ug;f=8lRK&syS^"JLc@~׺KmC" L̿ &]07 5K/2|ߖ݈7CL kmGY\iNr*/7`wendstream endobj 518 0 obj << /Filter /FlateDecode /Length 2064 >> stream xXݓ۶S\gFs/:GIȴ}tę|(ux"tB"i뻻HJ9sG~ Y'1_'OdzuOlW_lb%\o+yƅ,2/biurIִhKqE]kukG{l^mYqgR552 jnyͫWR7kc9ɬ~&of˒컓>)oާ/*Eӂ5+eP~_Ѿ4lw%t`ڇ KSx.*+mD*JgeR0dg6lוZ{R@;o~K2("ε<[K0~`Zm-f39ٯֹ :ujT5惮CaY֮>̞cFW׺'q$U 8-U$ɓ>=v.cyHEj.X8thu三0R)ցlK`%{{e3I poF6NKhAj1M8$& p65B*Mc(NE^}kg8|M2Q½eJHi&S 3& %]m8WGy.dKIεPNul,-i+LLx eBˠ!s6Uέ%whp n pH5f.FBMjP;A/^RF/`61"08tKK:R]OY W J >#yE젡ۅ#L!9qH~a: +s`uo1D:9X264Kx̽@ZWX/uMCa'.^5xƜ@9F%qZjaZyV<._\?<)Oy"e /KZP6DAA9 z K`|, kf8Q"5hmXXp̳=qL,ɊE YID9 `A;k.hD3!X#+q> stream xYɒω:[ ^\`@DP! ò=LCjM,G___efaa3Ę̬\^.: ]E+o^=m`S^_ɉ: K4'7wá.w:0ƪ8% lnnaTC}WQ=]/0QXWhgBaX8[G5v2FfI~SAʊkm B+x>h@0 ND0 M&A.Sno4Uw"~pY?8SU:Kb(I ƍngG0k`+Cl4ʹUu> kLE[˟i(4AbĭsJ LƑٺKY?NbTqpĊ_XnO[FwQ߯8蚻U-"V6|nj["#x股UL"  f V54s/^' #@}AExƬDvΒ\ lw'FȨ%DUޛPa`T?EE_䆚ZccڇE->yLx q m/YG`K؊}fe Om]4X ǫY K1[NӒN3S"/ܔzQO( Y)qd!} F cyޠ&S EL ݅|.I}KpS6ޤ8l, :N/bd `N$92S^%|ެ=hCY#3$ȸ#µ|"#F#@lwmC)c9%8az/ ΐM#Ǣ'k42P $(OBk'1QQ& LK^u3du;v~CP-U1 sm| $ڸTNX HΆ:WUh?G MOdCli+lRk?(J!iDxcb%H\pLh\psnR[ʌ2:Y`ҸbzIɜoc ) *q) Lfpۅ`.ay68lqÌʕ(M[B<o 5tI#>I*BN[HRd!tEQ_Kɍ} $oA7Jq+c͚܍F[ 瞛B U4,'3GIӕ0 At9ݶ3L7^~d z cG>SRgsP0)W(iWȝ5D/{C=O/9=TƳAnss9b0l|pa`޹`O1va8n:| %Aqs6e~}^ jvg:Hbuiz s ;ctDåB6|Τ_xs#t1mqMrK* 454уF4$ B5uٮ6Ʀŧ(KFRrXˋC^3uD1wbn*8L}9zĤA$@ӕ_hLVȒYsP̑~p~P)D5 dXσD% ggvsN"Ǩ}39_dJ"'t-pȧRnJ_ec`qWofo|qn:FIq9x4Zz;Rpjֻ@(y>}2zjGͫg~TƮsjmyhW|x =;X4O~~^%|YVEpC0Sjz$×CjokJ:?2ZĉpIf _S%֗g7͠^t~AgeM*)|{#o6yOpBj %XrLHer943 Jp!: ;KT#t۶!&x|ݯ/'КK)ji.׳Zy5D A#Mds5|!dyHC:>;}_shvr^u{idg e~Y2o $ ĉjt,zg/Ŧ& tq~FMyKU4̸^ jU)V#DI n~lݱزIZK5,TUReJ+4+>qirT!~K)&P}5);fKqy@ bfrnO&?Í }i6#'V}~i;1<<8W5_KXAR뛫endstream endobj 520 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1677 >> stream xT{lS{4s6SZн@&I(4B< "<DZ;۱S7 'd-݀fdm Qj&f}@9N$zݬoWGWɘ8F&ܝ~bY/.$@О.ti&$RQڣEe Q10L&fv2`v3{mLyZ`2-콛(:K7Jst{X `/V n͔ٶ*`=0wao߽w>\Ţu9}<#඘ԯTQ(edݜ|v1E 񐵤M0_#hVtM F֜jJ)({MHV?ēŋ-ur 2mZxN#ϰOl'ԮR֐ITfY'>n+Pyk'̹nΜ~sH+: m-f\{"ŽjV^ BBOwv]FS6{8A58{a~jyMZcW1\(u[-Z&K؊VXv튎C̀͂dduX~ߐùnӇ{**3rEut\gAf;>̽#Є[g64Ñ1^I榻~1A鞓O.JTvSE79K->$a4.ZBKNtwlT/hu#M*TB%WX5{GOq`P'"O1\/% .wrm.kpuvw8k P3~ 汽WpR<*Q081U1G*DBQtqp Yɖk\y/Š?;7cmY 347P-Z)UPWʂ1G>Z&oJ3hLytQeDdC].MwMq"}]< .ju6vALՖ0 8Qd5ʅDV(FLߵs&Չ¡7ӨD~P49bĺ> stream xkpWw.k44B!(L1)8~I%!ے#Y~J0Z[1@: a<)$0CBBCҹ\f |;;9+(D`^*ڹܹm1+d(񒫋ߏ"bHU_[2njʢ~AmS%J$*N @!JK%KQKoEVG?1,=I6ePEq(^` ν" 7ȕ}HHT2Y%VHYa6tm۹% PiQ5r)kZ6'IPU6^B &)ɐ!DqW XYG?&Iě8mYZN2P[Ow)9;d {a7-?HiAu>Ϛ>m NE|{Yv!K`CDNFr;6[ `HglA-SWx EYyXsx,M''yޡrEݏ_&>O[ˉeVd%:c^9E,{F@gՁiZL }8 $@b<.Hpm<}[:9\@#0*|jy^%rf)#F2hr6 "S?oY蹡 d#(t ?X׌uu":b*T٧8IBJ7jϑ}V^o>h1وs E /2tz\._FJZeE|AP+"[`bsbkĩsM97gEzQ`PlèܬbJ\(v~{`L8cG?ZzZk։w h? %ASdhtS_*PWqE%LX#&2` 6c|k=s/x\;RN2yb yOtM^H ̼i).̀vq‡ٖ 70? Nn$ܛ4>\8&mW47³e_H=rlp0ϯI{y7ri*5rcSd5 S NQM-s@f0d==/_~tcp?&WLա9idGzQ0ОăK|;tGpHGn< 8UXSQ]]QSyz.AV=dI>A-ws$3$6k{Z܅n a뤿kA9}g^ʤ> stream x}LSgW !$.!ư87Ȩ`P@ʀ^ʥoˇmiPvvYC3زeq8 Nrߓ<IH$V_+=}cI]k81zq^`w\K@C]XZE(Q:ltQ"GкȦAuq !%)֋ W :5P&;`!=#-546'7`Ho@^(4 bZ6Z{Ln>ܘhWq:lFS`DSRY]iڀ<{RDI/"y q:p}D2[@ʘ ]JыN/Ծ^yC $t![8ji5k/=qEiwWO<ɦP C{يޥ {>ҌN3U|,IWc n8kc[& uTCVЊv576%,kc'+/0U)y%%(2y*ђ_y#ue W0uPQ)Y#b HjjRDCj@> Uxb*ٮ91uNkik|<}c1f@goG;}6qmsTDS OR`&{]z'}SV^7(9_?3{nrc9 rlE:^0C}97l]vƁ,1N/^10Ie`-[ ;.Lz:dxatI NZďF[{ iOO17 N˕V5Ԗ*0E|V'a!Ƚ5S-bPL=d v~_`X#)LN}6QsywO8syg;@$,?? !F5FYCCIIS|l?'Nu{#̊Fendstream endobj 523 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3712 >> stream xW TSW>9VZ'u{E{mUŷ"V"! y y@ @yTji;U[Zm㲽Vw\;;ҙigfͺkMNֿfS,kڞMW^"cIytH83Μjż(tލ9sy`P$ΗHe)Ԃ̬rc-v;]b/O$D"H"67Mfb #FۉYlb!#=f/#^h:=2X.SۨikuO_8cɌ3Z4lO,9`/#f0 O% BS?|e^fu6pxu 's?H3<D/IE[ߜKR7'}rϯ")M4PT. 5F|j5ʢ7Ph ҆rt2\Lq',""337|8\2OIgrh8R q#\*XKMzAf6j0ΟhvOoBQ/a}d| e%jM1,BKuݞt`O 1>Ļ 7/Q#'8;sӞW/{[OlU yj:ϟhM}mfBM_]VR@+VMԞgCjEѴ‰@i̽㪶nSL e\E١N aPޔ(0`UVa*;ULLߴ$&w0LK_fw ݴT[`ԙoP"g ؜s]N&[ "O}CO M ' ܢ1fmj`Y. yBFps|̢Clw5=G۲,rX #CiA9H`@`րR}>gO~&N&G@ Kd% e P&K()>!6TͰ:tE*c=GGÏ];,|ͻz Mg{X~}𱁣K֦9iTxz`#XL_09cxEh^Hbݓ\ *g@ooKǺ*%BBQ by `Ըb5 KŲ9ߝD]U$g&E_YwЬhj{2%fE）<pհdc']Ðw4oBKkڊb],C#|q6PDFX 4B[V  a:j=A`憳|ԃyY[Hw1TAd@^?̜oGύO5ULٴcn$ &*uI但AO<Ǿ-Uaw@h9j49JDa)Ax"H5kWOocdEьࣺ]5]T*O(\Mޡ7%rcSŤs|HsȢcc+s@&SfC<bp:Zf2s[+l$۩Z3ҩU:u&}9vK+h@GK[qXPRΒ:T"^j P*RQVɥWYY(?FhG}/3­K[/h,zqwk/]9Kظ;oV.^AFOf8Ƴx+̹zrT԰J[*pܔ݈xR>Fh4~y. cęj!Фs,c-ࡁ aZSG>. [`\)UgvoZgS+H҂eiz~}@y ƃMwOï!,;J1/0_rx쵭gWəgK0{)(J1m/Nv0 41`UsC3.$簯R|8@V }_ɥ') }Ƒ1, @Kwڽ–c>VCن$JǮE=r\ŖK;$0 7 O8XC4mqn)dH`'Hۀ֗ PV*Ð7fN#X.oendstream endobj 524 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 486 >> stream x$ SFRB0900K  fucelVDFMsPV:wv# : xOYuoorVԅHHvru&cYnXOnEBeq&ȭ4`+}yyin*Q';!/̨ʩql}vwpk{k,Ǒ䙚5F6T5lX'!5!OP`[v̋юӮҍ}pww{sd\v^&њڞ,HlwHCYУnGYG! ? K1endstream endobj 525 0 obj << /Filter /FlateDecode /Length 1385 >> stream xWKs6Ԟ{ek1@DǓNrhFqDb#IͿ.@Jk1>QȦuWI40NObC&VMaҩIȅηk5Hy5cP3!prXUۇЮˆvwʮ#I6 vMk[͠6v#净'(Pܗ);s/ ^U BO֥Z" n?cQСJL&o`& H@.^_> H"0 -uP̯/:F81nm^6M-{w6Y]@yg/M4)xwgoaipƂ;]J%hæ(!jEr;39H$B|(Rm]mtgS6ލpL@> stream xYߏ~S^LOˠ-4N XmX!K;q͒wy׳a|~;\N~W_~RLoۉb8QrJ8ŵ:ODsw9~W㥝Z!5Wj;Kv{9N^\R^Yi`4V'ɴ juL+`oN:I;NtI"ȤIv?yLZU@r7PA)ōqSSztdb.tQ&`7[Q 7.] 3^Ϳ5 ZևOPnAf üecvhs]aLݱ,J|VxiFrY?'LUA!T6f%7^B{>fύNB7@.:dyhԖ;[-KC<yIN-=fJG;"R N8%ZiV*2FDЌl`"-,vB9Yg;bqQe|x8*hq>%Zf<ZVZn]nk$K׹8TH6h5`Kb8.5 ZO A8 lڮ6v(N\sFF;2+t[J* u0e4O&dU*0{5 4: $VP.tl)0bJ),h!*ܧ%FVh+33(yAUX2 xY>;O$rA? ZȦAy|kMd 2s؛'EdV @[ܛQ,z:|XRm9]aTN_=fO B%2h$?ps[#٠&8ijcRgiRܵ_P#q3thsCBXE_[a[<(鱲d˺!ؔ~[2R*NcUwbk5ɚW*ٷ:ξ۬{!luׇr_l{eM'*&O_þUYXGݜ6Xc bz,y4C2I4"'ZG40 N_gtmmD*Mm9nV Ps3`p"TK }Prtڳ>uFcԓ6llbfzH%l'䁚?I QP/"of$I(Sbf$Pٱ?0Ӫ L0l/"O3#T;U*{`/%UL׋2nG`-70C|ԃrSAo[8u6r*B`%[n݁$U`w[堻AZ]{*b]of_Uvs荒e?&yΏC!Mu\-,%zGbg KC^/  N`pXu(U^3Ǵ&?u-ٚ(R8sklM\Hx8 5l sZ&@7 jνUu=k67XcGʩ\:^[/:aj~U}#r d/6٪mz_W7EKCmgқ?41e"ע }B~  pi=zwbB˪o"A$~3ZMպ;6tfwz`["2uEq^-1`,o0y[=mUȶFj_5֪ݛmLbc4.hBЁ)4~ח?ݜȂ38`;D|Zg. ;mG[ԋ TQ=.U `_'~懎9 7͡%Azba{ @ .ﻯh@ԈC*>!]IڤJuJ\D 뢏Wendstream endobj 527 0 obj << /Type /XRef /Length 303 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 528 /ID [<611689bc1b29147f5934ce39876c2da4><0a2a8eaf4151d6040d62f7f2576790dd>] >> stream xcb&F~0 $8J8 "Kl}4|h% ڥrhj% rjhj% Բv4I@2 (He RTu<@$L@`d_V9Dj(AZ\`06d"cA$d@$37 Xs *_Hvkzk@U^```B``2CL V?,dK;Ggs/XఊnD} #3X%fg3=D= endstream endobj startxref 418956 %%EOF clue/inst/doc/clue.R0000644000175100001440000001736414503542730014033 0ustar hornikusers### R code from vignette source 'clue.Rnw' ################################################### ### code chunk number 1: clue.Rnw:40-42 ################################################### options(width = 60) library("clue") ################################################### ### code chunk number 2: clue.Rnw:310-319 ################################################### cl_class_ids.glvq <- function(x) as.cl_class_ids(x$class_ids) is.cl_partition.glvq <- function(x) TRUE is.cl_hard_partition.glvq <- function(x) TRUE ################################################### ### code chunk number 3: Cassini-data (eval = FALSE) ################################################### ## data("Cassini") ## plot(Cassini$x, col = as.integer(Cassini$classes), ## xlab = "", ylab = "") ################################################### ### code chunk number 4: clue.Rnw:889-890 ################################################### data("Cassini") plot(Cassini$x, col = as.integer(Cassini$classes), xlab = "", ylab = "") ################################################### ### code chunk number 5: CKME (eval = FALSE) ################################################### ## data("CKME") ## plot(hclust(cl_dissimilarity(CKME)), labels = FALSE) ################################################### ### code chunk number 6: clue.Rnw:903-904 ################################################### data("CKME") plot(hclust(cl_dissimilarity(CKME)), labels = FALSE) ################################################### ### code chunk number 7: clue.Rnw:914-916 ################################################### m1 <- cl_medoid(CKME) table(Medoid = cl_class_ids(m1), "True Classes" = Cassini$classes) ################################################### ### code chunk number 8: Cassini-medoid (eval = FALSE) ################################################### ## plot(Cassini$x, col = cl_class_ids(m1), xlab = "", ylab = "") ################################################### ### code chunk number 9: clue.Rnw:924-925 ################################################### plot(Cassini$x, col = cl_class_ids(m1), xlab = "", ylab = "") ################################################### ### code chunk number 10: clue.Rnw:934-936 ################################################### set.seed(1234) m2 <- cl_consensus(CKME) ################################################### ### code chunk number 11: clue.Rnw:941-942 ################################################### table(Consensus = cl_class_ids(m2), "True Classes" = Cassini$classes) ################################################### ### code chunk number 12: Cassini-mean (eval = FALSE) ################################################### ## plot(Cassini$x, col = cl_class_ids(m2), xlab = "", ylab = "") ################################################### ### code chunk number 13: clue.Rnw:950-951 ################################################### plot(Cassini$x, col = cl_class_ids(m2), xlab = "", ylab = "") ################################################### ### code chunk number 14: clue.Rnw:984-989 ################################################### data("GVME") GVME set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 3, verbose = TRUE)) ################################################### ### code chunk number 15: clue.Rnw:993-994 ################################################### mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) ################################################### ### code chunk number 16: clue.Rnw:998-1002 ################################################### data("GVME_Consensus") m2 <- GVME_Consensus[["MF1/3"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) ################################################### ### code chunk number 17: clue.Rnw:1009-1012 ################################################### set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) ################################################### ### code chunk number 18: clue.Rnw:1016-1019 ################################################### mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) m2 <- GVME_Consensus[["MF1/2"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) ################################################### ### code chunk number 19: clue.Rnw:1022-1023 ################################################### max(abs(cl_membership(m1) - cl_membership(m2))) ################################################### ### code chunk number 20: clue.Rnw:1027-1029 ################################################### m3 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) ################################################### ### code chunk number 21: clue.Rnw:1032-1033 ################################################### table(GV1 = cl_class_ids(m1), Euclidean = cl_class_ids(m3)) ################################################### ### code chunk number 22: clue.Rnw:1036-1037 ################################################### rownames(m1)[cl_class_ids(m1) != cl_class_ids(m3)] ################################################### ### code chunk number 23: clue.Rnw:1061-1066 ################################################### data("Kinship82") Kinship82 set.seed(1) m1 <- cl_consensus(Kinship82, method = "GV3", control = list(k = 3, verbose = TRUE)) ################################################### ### code chunk number 24: clue.Rnw:1071-1072 ################################################### mean(cl_dissimilarity(Kinship82, m1, "comem") ^ 2) ################################################### ### code chunk number 25: clue.Rnw:1076-1079 ################################################### data("Kinship82_Consensus") m2 <- Kinship82_Consensus[["JMF"]] mean(cl_dissimilarity(Kinship82, m2, "comem") ^ 2) ################################################### ### code chunk number 26: clue.Rnw:1083-1085 ################################################### cl_dissimilarity(m1, m2, "comem") table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) ################################################### ### code chunk number 27: clue.Rnw:1088-1089 ################################################### cl_fuzziness(cl_ensemble(m1, m2)) ################################################### ### code chunk number 28: clue.Rnw:1109-1111 ################################################### data("Phonemes") d <- as.dist(1 - Phonemes) ################################################### ### code chunk number 29: clue.Rnw:1115-1116 ################################################### u <- ls_fit_ultrametric(d, control = list(verbose = TRUE)) ################################################### ### code chunk number 30: Phonemes (eval = FALSE) ################################################### ## plot(u) ################################################### ### code chunk number 31: clue.Rnw:1126-1127 ################################################### plot(u) ################################################### ### code chunk number 32: clue.Rnw:1137-1138 ################################################### round(cl_dissimilarity(d, u), 4) ################################################### ### code chunk number 33: clue.Rnw:1141-1146 ################################################### hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hens <- cl_ensemble(list = lapply(hclust_methods, function(m) hclust(d, m))) names(hens) <- hclust_methods round(sapply(hens, cl_dissimilarity, d), 4) ################################################### ### code chunk number 34: clue.Rnw:1153-1155 ################################################### ahens <- c(L2opt = cl_ensemble(u), hens) round(cl_dissimilarity(ahens, method = "gamma"), 2) clue/inst/doc/clue.Rnw0000644000175100001440000016521512734170652014403 0ustar hornikusers\documentclass[fleqn]{article} \usepackage[round,longnamesfirst]{natbib} \usepackage{graphicx,keyval,hyperref,doi} \newcommand\argmin{\mathop{\mathrm{arg min}}} \newcommand\trace{\mathop{\mathrm{tr}}} \newcommand\R{{\mathbb{R}}} \newcommand{\pkg}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \let\code=\texttt \newcommand{\file}[1]{\sQuote{\textsf{#1}}} \newcommand{\class}[1]{\code{"#1"}} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \date{2007-06-28} \title{A CLUE for CLUster Ensembles} \author{Kurt Hornik} %% \VignetteIndexEntry{CLUster Ensembles} \sloppy{} \begin{document} \maketitle \begin{abstract} Cluster ensembles are collections of individual solutions to a given clustering problem which are useful or necessary to consider in a wide range of applications. The R package~\pkg{clue} provides an extensible computational environment for creating and analyzing cluster ensembles, with basic data structures for representing partitions and hierarchies, and facilities for computing on these, including methods for measuring proximity and obtaining consensus and ``secondary'' clusterings. \end{abstract} <>= options(width = 60) library("clue") @ % \section{Introduction} \label{sec:introduction} \emph{Cluster ensembles} are collections of clusterings, which are all of the same ``kind'' (e.g., collections of partitions, or collections of hierarchies), of a set of objects. Such ensembles can be obtained, for example, by varying the (hyper)parameters of a ``base'' clustering algorithm, by resampling or reweighting the set of objects, or by employing several different base clusterers. Questions of ``agreement'' in cluster ensembles, and obtaining ``consensus'' clusterings from it, have been studied in several scientific communities for quite some time now. A special issue of the Journal of Classification was devoted to ``Comparison and Consensus of Classifications'' \citep{cluster:Day:1986} almost two decades ago. The recent popularization of ensemble methods such as Bayesian model averaging \citep{cluster:Hoeting+Madigan+Raftery:1999}, bagging \citep{cluster:Breiman:1996} and boosting \citep{cluster:Friedman+Hastie+Tibshirani:2000}, typically in a supervised leaning context, has also furthered the research interest in using ensemble methods to improve the quality and robustness of cluster solutions. Cluster ensembles can also be utilized to aggregate base results over conditioning or grouping variables in multi-way data, to reuse existing knowledge, and to accommodate the needs of distributed computing, see e.g.\ \cite{cluster:Hornik:2005a} and \cite{cluster:Strehl+Ghosh:2003a} for more information. Package~\pkg{clue} is an extension package for R~\citep{cluster:R:2005} providing a computational environment for creating and analyzing cluster ensembles. In Section~\ref{sec:structures+algorithms}, we describe the underlying data structures, and the functionality for measuring proximity, obtaining consensus clusterings, and ``secondary'' clusterings. Four examples are discussed in Section~\ref{sec:examples}. Section~\ref{sec:outlook} concludes the paper. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{cluster:Hornik:2005b}. \section{Data structures and algorithms} \label{sec:structures+algorithms} \subsection{Partitions and hierarchies} Representations of clusterings of objects greatly vary across the multitude of methods available in R packages. For example, the class ids (``cluster labels'') for the results of \code{kmeans()} in base package~\pkg{stats}, \code{pam()} in recommended package~\pkg{cluster}~\citep{cluster:Rousseeuw+Struyf+Hubert:2005, cluster:Struyf+Hubert+Rousseeuw:1996}, and \code{Mclust()} in package~\pkg{mclust}~\citep{cluster:Fraley+Raftery+Wehrens:2005, cluster:Fraley+Raftery:2003}, are available as components named \code{cluster}, \code{clustering}, and \code{classification}, respectively, of the R objects returned by these functions. In many cases, the representations inherit from suitable classes. (We note that for versions of R prior to 2.1.0, \code{kmeans()} only returned a ``raw'' (unclassed) result, which was changed alongside the development of \pkg{clue}.) We deal with this heterogeneity of representations by providing getters for the key underlying data, such as the number of objects from which a clustering was obtained, and predicates, e.g.\ for determining whether an R object represents a partition of objects or not. These getters, such as \code{n\_of\_objects()}, and predicates are implemented as S3 generics, so that there is a \emph{conceptual}, but no formal class system underlying the predicates. Support for classed representations can easily be added by providing S3 methods. \subsubsection{Partitions} The partitions considered in \pkg{clue} are possibly soft (``fuzzy'') partitions, where for each object~$i$ and class~$j$ there is a non-negative number~$\mu_{ij}$ quantifying the ``belongingness'' or \emph{membership} of object~$i$ to class~$j$, with $\sum_j \mu_{ij} = 1$. For hard (``crisp'') partitions, all $\mu_{ij}$ are in $\{0, 1\}$. We can gather the $\mu_{ij}$ into the \emph{membership matrix} $M = [\mu_{ij}]$, where rows correspond to objects and columns to classes. The \emph{number of classes} of a partition, computed by function \code{n\_of\_classes()}, is the number of $j$ for which $\mu_{ij} > 0$ for at least one object~$i$. This may be less than the number of ``available'' classes, corresponding to the number of columns in a membership matrix representing the partition. The predicate functions \code{is.cl\_partition()}, \code{is.cl\_hard\_partition()}, and \code{is.cl\_soft\_partition()} are used to indicate whether R objects represent partitions of objects of the respective kind, with hard partitions as characterized above (all memberships in $\{0, 1\}$). (Hence, ``fuzzy clustering'' algorithms can in principle also give a hard partition.) \code{is.cl\_partition()} and \code{is.cl\_hard\_partition()} are generic functions; \code{is.cl\_soft\_partition()} gives true iff \code{is.cl\_partition()} is true and \code{is.cl\_hard\_partition()} is false. For R objects representing partitions, function \code{cl\_membership()} computes an R object with the membership values, currently always as a dense membership matrix with additional attributes. This is obviously rather inefficient for computations on hard partitions; we are planning to add ``canned'' sparse representations (using the vector of class ids) in future versions. Function \code{as.cl\_membership()} can be used for coercing \dQuote{raw} class ids (given as atomic vectors) or membership values (given as numeric matrices) to membership objects. Function \code{cl\_class\_ids()} determines the class ids of a partition. For soft partitions, the class ids returned are those of the \dQuote{nearest} hard partition obtained by taking the class ids of the (first) maximal membership values. Note that the cardinality of the set of the class ids may be less than the number of classes in the (soft) partition. Many partitioning methods are based on \emph{prototypes} (``centers''). In typical cases, these are points~$p_j$ in the same feature space the measurements~$x_i$ on the objects~$i$ to be partitioned are in, so that one can measure distance between objects and prototypes, and e.g.\ classify objects to their closest prototype. Such partitioning methods can also induce partitions of the entire feature space (rather than ``just'' the set of objects to be partitioned). Currently, package \pkg{clue} has only minimal support for this ``additional'' structure, providing a \code{cl\_prototypes()} generic for extracting the prototypes, and is mostly focused on computations on partitions which are based on their memberships. Many algorithms resulting in partitions of a given set of objects can be taken to induce a partition of the underlying feature space for the measurements on the objects, so that class memberships for ``new'' objects can be obtained from the induced partition. Examples include partitions based on assigning objects to their ``closest'' prototypes, or providing mixture models for the distribution of objects in feature space. Package~\pkg{clue} provides a \code{cl\_predict()} generic for predicting the class memberships of new objects (if possible). Function \code{cl\_fuzziness()} computes softness (fuzziness) measures for (ensembles) of partitions. Built-in measures are the partition coefficient \label{PC} and partition entropy \citep[e.g.,][]{cluster:Bezdek:1981}, with an option to normalize in a way that hard partitions and the ``fuzziest'' possible partition (where all memberships are the same) get fuzziness values of zero and one, respectively. Note that this normalization differs from ``standard'' ones in the literature. In the sequel, we shall also use the concept of the \emph{co-membership matrix} $C(M) = M M'$, where $'$ denotes matrix transposition, of a partition. For hard partitions, an entry $c_{ij}$ of $C(M)$ is 1 iff the corresponding objects $i$ and $j$ are in the same class, and 0 otherwise. \subsubsection{Hierarchies} The hierarchies considered in \pkg{clue} are \emph{total indexed hierarchies}, also known as \emph{$n$-valued trees}, and hence correspond in a one-to-one manner to \emph{ultrametrics} (distances $u_{ij}$ between pairs of objects $i$ and $j$ which satisfy the ultrametric constraint $u_{ij} = \max(u_{ik}, u_{jk})$ for all triples $i$, $j$, and $k$). See e.g.~\citet[Page~69--71]{cluster:Gordon:1999}. Function \code{cl\_ultrametric(x)} computes the associated ultrametric from an R object \code{x} representing a hierarchy of objects. If \code{x} is not an ultrametric, function \code{cophenetic()} in base package~\pkg{stats} is used to obtain the ultrametric (also known as cophenetic) distances from the hierarchy, which in turn by default calls the S3 generic \code{as.hclust()} (also in \pkg{stats}) on the hierarchy. Support for classes which represent hierarchies can thus be added by providing \code{as.hclust()} methods for this class. In R~2.1.0 or better (again as part of the work on \pkg{clue}), \code{cophenetic} is an S3 generic as well, and one can also more directly provide methods for this if necessary. In addition, there is a generic function \code{as.cl\_ultrametric()} which can be used for coercing \emph{raw} (non-classed) ultrametrics, represented as numeric vectors (of the lower-half entries) or numeric matrices, to ultrametric objects. Finally, the generic predicate function \code{is.cl\_hierarchy()} is used to determine whether an R object represents a hierarchy or not. Ultrametric objects can also be coerced to classes~\class{dendrogram} and \class{hclust} (from base package~\pkg{stats}), and hence in particular use the \code{plot()} methods for these classes. By default, plotting an ultrametric object uses the plot method for dendrograms. Obtaining a hierarchy on a given set of objects can be thought of as transforming the pairwise dissimilarities between the objects (which typically do not yet satisfy the ultrametric constraints) into an ultrametric. Ideally, this ultrametric should be as close as possible to the dissimilarities. In some important cases, explicit solutions are possible (e.g., ``standard'' hierarchical clustering with single or complete linkage gives the optimal ultrametric dominated by or dominating the dissimilarities, respectively). On the other hand, the problem of finding the closest ultrametric in the least squares sense is known to be NP-hard \citep{cluster:Krivanek+Moravek:1986,cluster:Krivanek:1986}. One important class of heuristics for finding least squares fits is based on iterative projection on convex sets of constraints \citep{cluster:Hubert+Arabie:1995}. \label{SUMT} Function \code{ls\_fit\_ultrametric()} follows \cite{cluster:DeSoete:1986} to use an SUMT \citep[Sequential Unconstrained Minimization Technique;][]{cluster:Fiacco+McCormick:1968} approach in turn simplifying the suggestions in \cite{cluster:Carroll+Pruzansky:1980}. Let $L(u)$ be the function to be minimized over all $u$ in some constrained set $\mathcal{U}$---in our case, $L(u) = \sum (d_{ij}-u_{ij})^2$ is the least squares criterion, and $\mathcal{U}$ is the set of all ultrametrics $u$. One iteratively minimizes $L(u) + \rho_k P(u)$, where $P(u)$ is a non-negative function penalizing violations of the constraints such that $P(u)$ is zero iff $u \in \mathcal{U}$. The $\rho$ values are increased according to the rule $\rho_{k+1} = q \rho_k$ for some constant $q > 1$, until convergence is obtained in the sense that e.g.\ the Euclidean distance between successive solutions $u_k$ and $u_{k+1}$ is small enough. Optionally, the final $u_k$ is then suitably projected onto $\mathcal{U}$. For \code{ls\_fit\_ultrametric()}, we obtain the starting value $u_0$ by \dQuote{random shaking} of the given dissimilarity object, and use the penalty function $P(u) = \sum_{\Omega} (u_{ij} - u_{jk}) ^ 2$, were $\Omega$ contains all triples $i, j, k$ for which $u_{ij} \le \min(u_{ik}, u_{jk})$ and $u_{ik} \ne u_{jk}$, i.e., for which $u$ violates the ultrametric constraints. The unconstrained minimizations are carried out using either \code{optim()} or \code{nlm()} in base package~\pkg{stats}, with analytic gradients given in \cite{cluster:Carroll+Pruzansky:1980}. This ``works'', even though we note however that $P$ is not even a continuous function, which seems to have gone unnoticed in the literature! (Consider an ultrametric $u$ for which $u_{ij} = u_{ik} < u_{jk}$ for some $i, j, k$ and define $u(\delta)$ by changing the $u_{ij}$ to $u_{ij} + \delta$. For $u$, both $(i,j,k)$ and $(j,i,k)$ are in the violation set $\Omega$, whereas for all $\delta$ sufficiently small, only $(j,i,k)$ is the violation set for $u(\delta)$. Hence, $\lim_{\delta\to 0} P(u(\delta)) = P(u) + (u_{ij} - u_{ik})^2$. This shows that $P$ is discontinuous at all non-constant $u$ with duplicated entries. On the other hand, it is continuously differentiable at all $u$ with unique entries.) Hence, we need to turn off checking analytical gradients when using \code{nlm()} for minimization. The default optimization using conjugate gradients should work reasonably well for medium to large size problems. For \dQuote{small} ones, using \code{nlm()} is usually faster. Note that the number of ultrametric constraints is of the order $n^3$, suggesting to use the SUMT approach in favor of \code{constrOptim()} in \pkg{stats}. It should be noted that the SUMT approach is a heuristic which can not be guaranteed to find the global minimum. Standard practice would recommend to use the best solution found in \dQuote{sufficiently many} replications of the base algorithm. \subsubsection{Extensibility} The methods provided in package~\pkg{clue} handle the partitions and hierarchies obtained from clustering functions in the base R distribution, as well as packages \pkg{RWeka}~\citep{cluster:Hornik+Hothorn+Karatzoglou:2006}, \pkg{cba}~\citep{cluster:Buchta+Hahsler:2005}, \pkg{cclust}~\citep{cluster:Dimitriadou:2005}, \pkg{cluster}, \pkg{e1071}~\citep{cluster:Dimitriadou+Hornik+Leisch:2005}, \pkg{flexclust}~\citep{cluster:Leisch:2006a}, \pkg{flexmix}~\citep{cluster:Leisch:2004}, \pkg{kernlab}~\citep{cluster:Karatzoglou+Smola+Hornik:2004}, and \pkg{mclust} (and of course, \pkg{clue} itself). Extending support to other packages is straightforward, provided that clusterings are instances of classes. Suppose e.g.\ that a package has a function \code{glvq()} for ``generalized'' (i.e., non-Euclidean) Learning Vector Quantization which returns an object of class~\class{glvq}, in turn being a list with component \code{class\_ids} containing the class ids. To integrate this into the \pkg{clue} framework, all that is necessary is to provide the following methods. <<>>= cl_class_ids.glvq <- function(x) as.cl_class_ids(x$class_ids) is.cl_partition.glvq <- function(x) TRUE is.cl_hard_partition.glvq <- function(x) TRUE @ % $ \subsection{Cluster ensembles} Cluster ensembles are realized as lists of clusterings with additional class information. All clusterings in an ensemble must be of the same ``kind'' (i.e., either all partitions as known to \code{is.cl\_partition()}, or all hierarchies as known to \code{is.cl\_hierarchy()}, respectively), and have the same number of objects. If all clusterings are partitions, the list realizing the ensemble has class~\class{cl\_partition\_ensemble} and inherits from \class{cl\_ensemble}; if all clusterings are hierarchies, it has class~\class{cl\_hierarchy\_ensemble} and inherits from \class{cl\_ensemble}. Empty ensembles cannot be categorized according to the kind of clusterings they contain, and hence only have class~\class{cl\_ensemble}. Function \code{cl\_ensemble()} creates a cluster ensemble object from clusterings given either one-by-one, or as a list passed to the \code{list} argument. As unclassed lists could be used to represent single clusterings (in particular for results from \code{kmeans()} in versions of R prior to 2.1.0), we prefer not to assume that an unnamed given list is a list of clusterings. \code{cl\_ensemble()} verifies that all given clusterings are of the same kind, and all have the same number of objects. (By the notion of cluster ensembles, we should in principle verify that the clusterings come from the \emph{same} objects, which of course is not always possible.) The list representation makes it possible to use \code{lapply()} for computations on the individual clusterings in (i.e., the components of) a cluster ensemble. Available methods for cluster ensembles include those for subscripting, \code{c()}, \code{rep()}, \code{print()}, and \code{unique()}, where the last is based on a \code{unique()} method for lists added in R~2.1.1, and makes it possible to find unique and duplicated elements in cluster ensembles. The elements of the ensemble can be tabulated using \code{cl\_tabulate()}. Function \code{cl\_boot()} generates cluster ensembles with bootstrap replicates of the results of applying a \dQuote{base} clustering algorithm to a given data set. Currently, this is a rather simple-minded function with limited applicability, and mostly useful for studying the effect of (uncontrolled) random initializations of fixed-point partitioning algorithms such as \code{kmeans()} or \code{cmeans()} in package~\pkg{e1071}. To study the effect of varying control parameters or explicitly providing random starting values, the respective cluster ensemble has to be generated explicitly (most conveniently by using \code{replicate()} to create a list \code{lst} of suitable instances of clusterings obtained by the base algorithm, and using \code{cl\_ensemble(list = lst)} to create the ensemble). Resampling the training data is possible for base algorithms which can predict the class memberships of new data using \code{cl\_predict} (e.g., by classifying the out-of-bag data to their closest prototype). In fact, we believe that for unsupervised learning methods such as clustering, \emph{reweighting} is conceptually superior to resampling, and have therefore recently enhanced package~\pkg{e1071} to provide an implementation of weighted fuzzy $c$-means, and package~\pkg{flexclust} contains an implementation of weighted $k$-means. We are currently experimenting with interfaces for providing ``direct'' support for reweighting via \code{cl\_boot()}. \subsection{Cluster proximities} \subsubsection{Principles} Computing dissimilarities and similarities (``agreements'') between clusterings of the same objects is a key ingredient in the analysis of cluster ensembles. The ``standard'' data structures available for such proximity data (measures of similarity or dissimilarity) are classes~\class{dist} and \class{dissimilarity} in package~\pkg{cluster} (which basically, but not strictly, extends \class{dist}), and are both not entirely suited to our needs. First, they are confined to \emph{symmetric} dissimilarity data. Second, they do not provide enough reflectance. We also note that the Bioconductor package~\pkg{graph}~\citep{cluster:Gentleman+Whalen:2005} contains an efficient subscript method for objects of class~\class{dist}, but returns a ``raw'' matrix for row/column subscripting. For package~\pkg{clue}, we use the following approach. There are classes for symmetric and (possibly) non-symmetric proximity data (\class{cl\_proximity} and \class{cl\_cross\_proximity}), which, in addition to holding the numeric data, also contain a description ``slot'' (attribute), currently a character string, as a first approximation to providing more reflectance. Internally, symmetric proximity data are store the lower diagonal proximity values in a numeric vector (in row-major order), i.e., the same way as objects of class~\class{dist}; a \code{self} attribute can be used for diagonal values (in case some of these are non-zero). Symmetric proximity objects can be coerced to dense matrices using \code{as.matrix()}. It is possible to use 2-index matrix-style subscripting for symmetric proximity objects; unless this uses identical row and column indices, it results in a non-symmetric proximity object. This approach ``propagates'' to classes for symmetric and (possibly) non-symmetric cluster dissimilarity and agreement data (e.g., \class{cl\_dissimilarity} and \class{cl\_cross\_dissimilarity} for dissimilarity data), which extend the respective proximity classes. Ultrametric objects are implemented as symmetric proximity objects with a dissimilarity interpretation so that self-proximities are zero, and inherit from classes~\class{cl\_dissimilarity} and \class{cl\_proximity}. Providing reflectance is far from optimal. For example, if \code{s} is a similarity object (with cluster agreements), \code{1 - s} is a dissimilarity one, but the description is preserved unchanged. This issue could be addressed by providing high-level functions for transforming proximities. \label{synopsis} Cluster dissimilarities are computed via \code{cl\_dissimilarity()} with synopsis \code{cl\_dissimilarity(x, y = NULL, method = "euclidean")}, where \code{x} and \code{y} are cluster ensemble objects or coercible to such, or \code{NULL} (\code{y} only). If \code{y} is \code{NULL}, the return value is an object of class~\class{cl\_dissimilarity} which contains the dissimilarities between all pairs of clusterings in \code{x}. Otherwise, it is an object of class~\class{cl\_cross\_dissimilarity} with the dissimilarities between the clusterings in \code{x} and the clusterings in \code{y}. Formal argument \code{method} is either a character string specifying one of the built-in methods for computing dissimilarity, or a function to be taken as a user-defined method, making it reasonably straightforward to add methods. Function \code{cl\_agreement()} has the same interface as \code{cl\_dissimilarity()}, returning cluster similarity objects with respective classes~\class{cl\_agreement} and \class{cl\_cross\_agreement}. Built-in methods for computing dissimilarities may coincide (in which case they are transforms of each other), but do not necessarily do so, as there typically are no canonical transformations. E.g., according to needs and scientific community, agreements might be transformed to dissimilarities via $d = - \log(s)$ or the square root thereof \citep[e.g.,][]{cluster:Strehl+Ghosh:2003b}, or via $d = 1 - s$. \subsubsection{Partition proximities} When assessing agreement or dissimilarity of partitions, one needs to consider that the class ids may be permuted arbitrarily without changing the underlying partitions. For membership matrices~$M$, permuting class ids amounts to replacing $M$ by $M \Pi$, where $\Pi$ is a suitable permutation matrix. We note that the co-membership matrix $C(M) = MM'$ is unchanged by these transformations; hence, proximity measures based on co-occurrences, such as the Katz-Powell \citep{cluster:Katz+Powell:1953} or Rand \citep{cluster:Rand:1971} indices, do not explicitly need to adjust for possible re-labeling. The same is true for measures based on the ``confusion matrix'' $M' \tilde{M}$ of two membership matrices $M$ and $\tilde{M}$ which are invariant under permutations of rows and columns, such as the Normalized Mutual Information (NMI) measure introduced in \cite{cluster:Strehl+Ghosh:2003a}. Other proximity measures need to find permutations so that the classes are optimally matched, which of course in general requires exhaustive search through all $k!$ possible permutations, where $k$ is the (common) number of classes in the partitions, and thus will typically be prohibitively expensive. Fortunately, in some important cases, optimal matchings can be determined very efficiently. We explain this in detail for ``Euclidean'' partition dissimilarity and agreement (which in fact is the default measure used by \code{cl\_dissimilarity()} and \code{cl\_agreement()}). Euclidean partition dissimilarity \citep{cluster:Dimitriadou+Weingessel+Hornik:2002} is defined as \begin{displaymath} d(M, \tilde{M}) = \min\nolimits_\Pi \| M - \tilde{M} \Pi \| \end{displaymath} where the minimum is taken over all permutation matrices~$\Pi$, $\|\cdot\|$ is the Frobenius norm (so that $\|Y\|^2 = \trace(Y'Y)$), and $n$ is the (common) number of objects in the partitions. As $\| M - \tilde{M} \Pi \|^2 = \trace(M'M) - 2 \trace(M'\tilde{M}\Pi) + \trace(\Pi'\tilde{M}'\tilde{M}\Pi) = \trace(M'M) - 2 \trace(M'\tilde{M}\Pi) + \trace(\tilde{M}'\tilde{M})$, we see that minimizing $\| M - \tilde{M} \Pi \|^2$ is equivalent to maximizing $\trace(M'\tilde{M}\Pi) = \sum_{i,k}{\mu_{ik}\tilde{\mu}}_{i,\pi(k)}$, which for hard partitions is the number of objects with the same label in the partitions given by $M$ and $\tilde{M}\Pi$. Finding the optimal $\Pi$ is thus recognized as an instance of the \emph{linear sum assignment problem} (LSAP, also known as the weighted bipartite graph matching problem). The LSAP can be solved by linear programming, e.g., using Simplex-style primal algorithms as done by function~\code{lp.assign()} in package~\pkg{lpSolve}~\citep{cluster:Buttrey:2005}, but primal-dual algorithms such as the so-called Hungarian method can be shown to find the optimum in time $O(k^3)$ \citep[e.g.,][]{cluster:Papadimitriou+Steiglitz:1982}. Available published implementations include TOMS 548 \citep{cluster:Carpaneto+Toth:1980}, which however is restricted to integer weights and $k < 131$. One can also transform the LSAP into a network flow problem, and use e.g.~RELAX-IV \citep{cluster:Bertsekas+Tseng:1994} for solving this, as is done in package~\pkg{optmatch}~\citep{cluster:Hansen:2005}. In package~\pkg{clue}, we use an efficient C implementation of the Hungarian algorithm kindly provided to us by Walter B\"ohm, which has been found to perform very well across a wide range of problem sizes. \cite{cluster:Gordon+Vichi:2001} use a variant of Euclidean dissimilarity (``GV1 dissimilarity'') which is based on the sum of the squared difference of the memberships of matched (non-empty) classes only, discarding the unmatched ones (see their Example~2). This results in a measure which is discontinuous over the space of soft partitions with arbitrary numbers of classes. The partition agreement measures ``angle'' and ``diag'' (maximal cosine of angle between the memberships, and maximal co-classification rate, where both maxima are taken over all column permutations of the membership matrices) are based on solving the same LSAP as for Euclidean dissimilarity. Finally, Manhattan partition dissimilarity is defined as the minimal sum of the absolute differences of $M$ and all column permutations of $\tilde{M}$, and can again be computed efficiently by solving an LSAP. For hard partitions, both Manhattan and squared Euclidean dissimilarity give twice the \emph{transfer distance} \citep{cluster:Charon+Denoeud+Guenoche:2006}, which is the minimum number of objects that must be removed so that the implied partitions (restrictions to the remaining objects) are identical. This is also known as the \emph{$R$-metric} in \cite{cluster:Day:1981}, i.e., the number of augmentations and removals of single objects needed to transform one partition into the other, and the \emph{partition-distance} in \cite{cluster:Gusfield:2002}. Note when assessing proximity that agreements for soft partitions are always (and quite often considerably) lower than the agreements for the corresponding nearest hard partitions, unless the agreement measures are based on the latter anyways (as currently done for Rand, Katz-Powell, and NMI). Package~\pkg{clue} provides additional agreement measures, such as the Jaccard and Fowles-Mallows \citep[quite often incorrectly attributed to \cite{cluster:Wallace:1983}]{cluster:Fowlkes+Mallows:1983a} indices, and dissimilarity measures such as the ``symdiff'' and Rand distances (the latter is proportional to the metric of \cite{cluster:Mirkin:1996}) and the metrics discussed in \cite{cluster:Boorman+Arabie:1972}. One could easily add more proximity measures, such as the ``Variation of Information'' \citep{cluster:Meila:2003}. However, all these measures are rigorously defined for hard partitions only. To see why extensions to soft partitions are far from straightforward, consider e.g.\ measures based on the confusion matrix. Its entries count the cardinality of certain intersections of sets. \label{fuzzy} In a fuzzy context for soft partitions, a natural generalization would be using fuzzy cardinalities (i.e., sums of memberships values) of fuzzy intersections instead. There are many possible choices for the latter, with the product of the membership values (corresponding to employing the confusion matrix also in the fuzzy case) one of them, but the minimum instead of the product being the ``usual'' choice. A similar point can be made for co-occurrences of soft memberships. We are not aware of systematic investigations of these extension issues. \subsubsection{Hierarchy proximities} Available built-in dissimilarity measures for hierarchies include \emph{Euclidean} (again, the default measure used by \code{cl\_dissimilarity()}) and Manhattan dissimilarity, which are simply the Euclidean (square root of the sum of squared differences) and Manhattan (sum of the absolute differences) dissimilarities between the associated ultrametrics. Cophenetic dissimilarity is defined as $1 - c^2$, where $c$ is the cophenetic correlation coefficient \citep{cluster:Sokal+Rohlf:1962}, i.e., the Pearson product-moment correlation between the ultrametrics. Gamma dissimilarity is the rate of inversions between the associated ultrametrics $u$ and $v$ (i.e., the rate of pairs $(i,j)$ and $(k,l)$ for which $u_{ij} < u_{kl}$ and $v_{ij} > v_{kl}$). This measure is a linear transformation of Kruskal's~$\gamma$. Finally, symdiff dissimilarity is the cardinality of the symmetric set difference of the sets of classes (hierarchies in the strict sense) induced by the dendrograms. Associated agreement measures are obtained by suitable transformations of the dissimilarities~$d$; for Euclidean proximities, we prefer to use $1 / (1 + d)$ rather than e.g.\ $\exp(-d)$. One should note that whereas cophenetic and gamma dissimilarities are invariant to linear transformations, Euclidean and Manhattan ones are not. Hence, if only the relative ``structure'' of the dendrograms is of interest, these dissimilarities should only be used after transforming the ultrametrics to a common range of values (e.g., to $[0,1]$). \subsection{Consensus clusterings} Consensus clusterings ``synthesize'' the information in the elements of a cluster ensemble into a single clustering. There are three main approaches to obtaining consensus clusterings \citep{cluster:Hornik:2005a,cluster:Gordon+Vichi:2001}: in the \emph{constructive} approach, one specifies a way to construct a consensus clustering. In the \emph{axiomatic} approach, emphasis is on the investigation of existence and uniqueness of consensus clusterings characterized axiomatically. The \emph{optimization} approach formalizes the natural idea of describing consensus clusterings as the ones which ``optimally represent the ensemble'' by providing a criterion to be optimized over a suitable set $\mathcal{C}$ of possible consensus clusterings. If $d$ is a dissimilarity measure and $C_1, \ldots, C_B$ are the elements of the ensemble, one can e.g.\ look for solutions of the problem \begin{displaymath} \sum\nolimits_{b=1}^B w_b d(C, C_b) ^ p \Rightarrow \min\nolimits_{C \in \mathcal{C}}, \end{displaymath} for some $p \ge 0$, i.e., as clusterings~$C^*$ minimizing weighted average dissimilarity powers of order~$p$. Analogously, if a similarity measure is given, one can look for clusterings maximizing weighted average similarity powers. Following \cite{cluster:Gordon+Vichi:1998}, an above $C^*$ is referred to as (weighted) \emph{median} or \emph{medoid} clustering if $p = 1$ and the optimum is sought over the set of all possible base clusterings, or the set $\{ C_1, \ldots, C_B \}$ of the base clusterings, respectively. For $p = 2$, we have \emph{least squares} consensus clusterings (generalized means). For computing consensus clusterings, package~\pkg{clue} provides function \code{cl\_consensus()} with synopsis \code{cl\_consensus(x, method = NULL, weights = 1, control = list())}. This allows (similar to the functions for computing cluster proximities, see Section~\ref{synopsis} on Page~\pageref{synopsis}) argument \code{method} to be a character string specifying one of the built-in methods discussed below, or a function to be taken as a user-defined method (taking an ensemble, the case weights, and a list of control parameters as its arguments), again making it reasonably straightforward to add methods. In addition, function~\code{cl\_medoid()} can be used for obtaining medoid partitions (using, in principle, arbitrary dissimilarities). Modulo possible differences in the case of ties, this gives the same results as (the medoid obtained by) \code{pam()} in package~\pkg{cluster}. If all elements of the ensemble are partitions, package~\pkg{clue} provides algorithms for computing soft least squares consensus partitions for weighted Euclidean, GV1 and co-membership dissimilarities. Let $M_1, \ldots, M_B$ and $M$ denote the membership matrices of the elements of the ensemble and their sought least squares consensus partition, respectively. For Euclidean dissimilarity, we need to find \begin{displaymath} \sum_b w_b \min\nolimits_{\Pi_b} \| M - M_b \Pi_b \|^2 \Rightarrow \min\nolimits_M \end{displaymath} over all membership matrices (i.e., stochastic matrices) $M$, or equivalently, \begin{displaymath} \sum_b w_b \| M - M_b \Pi_b \|^2 \Rightarrow \min\nolimits_{M, \Pi_1, \ldots, \Pi_B} \end{displaymath} over all $M$ and permutation matrices $\Pi_1, \ldots, \Pi_B$. Now fix the $\Pi_b$ and let $\bar{M} = s^{-1} \sum_b w_b M_b \Pi_b$ be the weighted average of the $M_b \Pi_b$, where $s = \sum_b w_b$. Then \begin{eqnarray*} \lefteqn{\sum_b w_b \| M - M_b \Pi_b \|^2} \\ &=& \sum_b w_b (\|M\|^2 - 2 \trace(M' M_b \Pi_b) + \|M_b\Pi_b\|^2) \\ &=& s \|M\|^2 - 2 s \trace(M' \bar{M}) + \sum_b w_b \|M_b\|^2 \\ &=& s (\|M - \bar{M}\|^2) + \sum_b w_b \|M_b\|^2 - s \|\bar{M}\|^2 \end{eqnarray*} Thus, as already observed in \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} and \cite{cluster:Gordon+Vichi:2001}, for fixed permutations $\Pi_b$ the optimal soft $M$ is given by $\bar{M}$. The optimal permutations can be found by minimizing $- s \|\bar{M}\|^2$, or equivalently, by maximizing \begin{displaymath} s^2 \|\bar{M}\|^2 = \sum_{\beta, b} w_\beta w_b \trace(\Pi_\beta'M_\beta'M_b\Pi_b). \end{displaymath} With $U_{\beta,b} = w_\beta w_b M_\beta' M_b$ we can rewrite the above as \begin{displaymath} \sum_{\beta, b} w_\beta w_b \trace(\Pi_\beta'M_\beta'M_b\Pi_b) = \sum_{\beta,b} \sum_{j=1}^k [U_{\beta,b}]_{\pi_\beta(j), \pi_b(j)} =: \sum_{j=1}^k c_{\pi_1(j), \ldots, \pi_B(j)} \end{displaymath} This is an instance of the \emph{multi-dimensional assignment problem} (MAP), which, contrary to the LSAP, is known to be NP-hard \citep[e.g., via reduction to 3-DIMENSIONAL MATCHING,][]{cluster:Garey+Johnson:1979}, and can e.g.\ be approached using randomized parallel algorithms \citep{cluster:Oliveira+Pardalos:2004}. Branch-and-bound approaches suggested in the literature \citep[e.g.,][]{cluster:Grundel+Oliveira+Pardalos:2005} are unfortunately computationally infeasible for ``typical'' sizes of cluster ensembles ($B \ge 20$, maybe even in the hundreds). Package~\pkg{clue} provides two heuristics for (approximately) finding the soft least squares consensus partition for Euclidean dissimilarity. Method \code{"DWH"} of function \code{cl\_consensus()} is an extension of the greedy algorithm in \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} which is based on a single forward pass through the ensemble which in each step chooses the ``locally'' optimal $\Pi$. Starting with $\tilde{M}_1 = M_1$, $\tilde{M}_b$ is obtained from $\tilde{M}_{b-1}$ by optimally matching $M_b \Pi_b$ to this, and taking a weighted average of $\tilde{M}_{b-1}$ and $M_b \Pi_b$ in a way that $\tilde{M}_b$ is the weighted average of the first~$b$ $M_\beta \Pi_\beta$. This simple approach could be further enhanced via back-fitting or several passes, in essence resulting in an ``on-line'' version of method \code{"SE"}. This, in turn, is a fixed-point algorithm, which iterates between updating $M$ as the weighted average of the current $M_b \Pi_b$, and determining the $\Pi_b$ by optimally matching the current $M$ to the individual $M_b$. Finally, method \code{"GV1"} implements the fixed-point algorithm for the ``first model'' in \cite{cluster:Gordon+Vichi:2001}, which gives least squares consensus partitions for GV1 dissimilarity. In the above, we implicitly assumed that all partitions in the ensemble as well as the sought consensus partition have the same number of classes. The more general case can be dealt with through suitable ``projection'' devices. When using co-membership dissimilarity, the least squares consensus partition is determined by minimizing \begin{eqnarray*} \lefteqn{\sum_b w_b \|MM' - M_bM_b'\|^2} \\ &=& s \|MM' - \bar{C}\|^2 + \sum_b w_b \|M_bM_b'\|^2 - s \|\bar{C}\|^2 \end{eqnarray*} over all membership matrices~$M$, where now $\bar{C} = s^{-1} \sum_b C(M_b) = s^{-1} \sum_b M_bM_b'$ is the weighted average co-membership matrix of the ensemble. This corresponds to the ``third model'' in \cite{cluster:Gordon+Vichi:2001}. Method \code{"GV3"} of function \code{cl\_consensus()} provides a SUMT approach (see Section~\ref{SUMT} on Page~\pageref{SUMT}) for finding the minimum. We note that this strategy could more generally be applied to consensus problems of the form \begin{displaymath} \sum_b w_b \|\Phi(M) - \Phi(M_b)\|^2 \Rightarrow \min\nolimits_M, \end{displaymath} which are equivalent to minimizing $\|\Phi(B) - \bar{\Phi}\|^2$, with $\bar{\Phi}$ the weighted average of the $\Phi(M_b)$. This includes e.g.\ the case where generalized co-memberships are defined by taking the ``standard'' fuzzy intersection of co-incidences, as discussed in Section~\ref{fuzzy} on Page~\pageref{fuzzy}. Package~\pkg{clue} currently does not provide algorithms for obtaining \emph{hard} consensus partitions, as e.g.\ done in \cite{cluster:Krieger+Green:1999} using Rand proximity. It seems ``natural'' to extend the methods discussed above to include a constraint on softness, e.g., on the partition coefficient PC (see Section~\ref{PC} on Page~\pageref{PC}). For Euclidean dissimilarity, straightforward Lagrangian computations show that the constrained minima are of the form $\bar{M}(\alpha) = \alpha \bar{M} + (1 - \alpha) E$, where $E$ is the ``maximally soft'' membership with all entries equal to $1/k$, $\bar{M}$ is again the weighted average of the $M_b\Pi_b$ with the $\Pi_b$ solving the underlying MAP, and $\alpha$ is chosen such that $PC(\bar{M}(\alpha))$ equals a prescribed value. As $\alpha$ increases (even beyond one), softness of the $\bar{M}(\alpha)$ decreases. However, for $\alpha^* > 1 / (1 - k\mu^*)$, where $\mu^*$ is the minimum of the entries of $\bar{M}$, the $\bar{M}(\alpha)$ have negative entries, and are no longer feasible membership matrices. Obviously, the non-negativity constraints for the $\bar{M}(\alpha)$ eventually put restrictions on the admissible $\Pi_b$ in the underlying MAP. Thus, such a simple relaxation approach to obtaining optimal hard partitions is not feasible. For ensembles of hierarchies, \code{cl\_consensus()} provides a built-in method (\code{"cophenetic"}) for approximately minimizing average weighted squared Euclidean dissimilarity \begin{displaymath} \sum_b w_b \| U - U_b \|^2 \Rightarrow \min\nolimits_U \end{displaymath} over all ultrametrics~$U$, where $U_1, \ldots, U_B$ are the ultrametrics corresponding to the elements of the ensemble. This is of course equivalent to minimizing $\| U - \bar{U} \|^2$, where $\bar{U} = s^{-1} \sum_b w_b U_b$ is the weighted average of the $U_b$. The SUMT approach provided by function \code{ls\_fit\_ultrametric()} (see Section~\ref{SUMT} on Page~\pageref{SUMT}) is employed for finding the sought weighted least squares consensus hierarchy. In addition, method \code{"majority"} obtains a consensus hierarchy from an extension of the majority consensus tree of \cite{cluster:Margush+McMorris:1981}, which minimizes $L(U) = \sum_b w_b d(U_b, U)$ over all ultrametrics~$U$, where $d$ is the symmetric difference dissimilarity. Clearly, the available methods use heuristics for solving hard optimization problems, and cannot be guaranteed to find a global optimum. Standard practice would recommend to use the best solution found in ``sufficiently many'' replications of the methods. Alternative recent approaches to obtaining consensus partitions include ``Bagged Clustering'' \citep[provided by \code{bclust()} in package~\pkg{e1071}]{cluster:Leisch:1999}, the ``evidence accumulation'' framework of \cite{cluster:Fred+Jain:2002}, the NMI optimization and graph-partitioning methods in \cite{cluster:Strehl+Ghosh:2003a}, ``Bagged Clustering'' as in \cite{cluster:Dudoit+Fridlyand:2003}, and the hybrid bipartite graph formulation of \cite{cluster:Fern+Brodley:2004}. Typically, these approaches are constructive, and can easily be implemented based on the infrastructure provided by package~\pkg{clue}. Evidence accumulation amounts to standard hierarchical clustering of the average co-membership matrix. Procedure~BagClust1 of \cite{cluster:Dudoit+Fridlyand:2003} amounts to computing $B^{-1} \sum_b M_b\Pi_b$, where each $\Pi_b$ is determined by optimal Euclidean matching of $M_b$ to a fixed reference membership $M_0$. In the corresponding ``Bagged Clustering'' framework, $M_0$ and the $M_b$ are obtained by applying the base clusterer to the original data set and bootstrap samples from it, respectively. This is implemented as method \code{"DFBC1"} of \code{cl\_bag()} in package~\pkg{clue}. Finally, the approach of \cite{cluster:Fern+Brodley:2004} solves an LSAP for an asymmetric cost matrix based on object-by-all-classes incidences. \subsection{Cluster partitions} To investigate the ``structure'' in a cluster ensemble, an obvious idea is to start clustering the clusterings in the ensemble, resulting in ``secondary'' clusterings \citep{cluster:Gordon+Vichi:1998, cluster:Gordon:1999}. This can e.g.\ be performed by using \code{cl\_dissimilarity()} (or \code{cl\_agreement()}) to compute a dissimilarity matrix for the ensemble, and feed this into a dissimilarity-based clustering algorithm (such as \code{pam()} in package~\pkg{cluster} or \code{hclust()} in package~\pkg{stats}). (One can even use \code{cutree()} to obtain hard partitions from hierarchies thus obtained.) If prototypes (``typical clusterings'') are desired for partitions of clusterings, they can be determined post-hoc by finding suitable consensus clusterings in the classes of the partition, e.g., using \code{cl\_consensus()} or \code{cl\_medoid()}. Package~\pkg{clue} additionally provides \code{cl\_pclust()} for direct prototype-based partitioning based on minimizing criterion functions of the form $\sum w_b u_{bj}^m d(x_b, p_j)^e$, the sum of the case-weighted membership-weighted $e$-th powers of the dissimilarities between the elements~$x_b$ of the ensemble and the prototypes~$p_j$, for suitable dissimilarities~$d$ and exponents~$e$. (The underlying feature spaces are that of membership matrices and ultrametrics, respectively, for partitions and hierarchies.) Parameter~$m$ must not be less than one and controls the softness of the obtained partitions, corresponding to the \dQuote{fuzzification parameter} of the fuzzy $c$-means algorithm. For $m = 1$, a generalization of the Lloyd-Forgy variant \citep{cluster:Lloyd:1957, cluster:Forgy:1965, cluster:Lloyd:1982} of the $k$-means algorithm is used, which iterates between reclassifying objects to their closest prototypes, and computing new prototypes as consensus clusterings for the classes. \citet{cluster:Gaul+Schader:1988} introduced this procedure for \dQuote{Clusterwise Aggregation of Relations} (with the same domains), containing equivalence relations, i.e., hard partitions, as a special case. For $m > 1$, a generalization of the fuzzy $c$-means recipe \citep[e.g.,][]{cluster:Bezdek:1981} is used, which alternates between computing optimal memberships for fixed prototypes, and computing new prototypes as the suitably weighted consensus clusterings for the classes. This procedure is repeated until convergence occurs, or the maximal number of iterations is reached. Consensus clusterings are computed using (one of the methods provided by) \code{cl\_consensus}, with dissimilarities~$d$ and exponent~$e$ implied by method employed, and obtained via a registration mechanism. The default methods compute Least Squares Euclidean consensus clusterings, i.e., use Euclidean dissimilarity~$d$ and $e = 2$. \section{Examples} \label{sec:examples} \subsection{Cassini data} \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} and \cite{cluster:Leisch:1999} use Cassini data sets to illustrate how e.g.\ suitable aggregation of base $k$-means results can reveal underlying non-convex structure which cannot be found by the base algorithm. Such data sets contain points in 2-dimensional space drawn from the uniform distribution on 3 structures, with the two ``outer'' ones banana-shaped and the ``middle'' one a circle, and can be obtained by function~\code{mlbench.cassini()} in package~\pkg{mlbench}~\citep{cluster:Leisch+Dimitriadou:2005}. Package~\pkg{clue} contains the data sets \code{Cassini} and \code{CKME}, which are an instance of a 1000-point Cassini data set, and a cluster ensemble of 50 $k$-means partitions of the data set into three classes, respectively. The data set is shown in Figure~\ref{fig:Cassini}. <>= data("Cassini") plot(Cassini$x, col = as.integer(Cassini$classes), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{The Cassini data set.} \label{fig:Cassini} \end{figure} Figure~\ref{fig:CKME} gives a dendrogram of the Euclidean dissimilarities of the elements of the $k$-means ensemble. <>= data("CKME") plot(hclust(cl_dissimilarity(CKME)), labels = FALSE) @ % \begin{figure} \centering <>= <> @ % \caption{A dendrogram of the Euclidean dissimilarities of 50 $k$-means partitions of the Cassini data into 3 classes.} \label{fig:CKME} \end{figure} We can see that there are large groups of essentially identical $k$-means solutions. We can gain more insight by inspecting representatives of these three groups, or by computing the medoid of the ensemble <<>>= m1 <- cl_medoid(CKME) table(Medoid = cl_class_ids(m1), "True Classes" = Cassini$classes) @ % $ and inspecting it (Figure~\ref{fig:Cassini-medoid}): <>= plot(Cassini$x, col = cl_class_ids(m1), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{Medoid of the Cassini $k$-means ensemble.} \label{fig:Cassini-medoid} \end{figure} Flipping this solution top-down gives a second ``typical'' partition. We see that the $k$-means base clusterers cannot resolve the underlying non-convex structure. For the least squares consensus of the ensemble, we obtain <<>>= set.seed(1234) m2 <- cl_consensus(CKME) @ % where here and below we set the random seed for reproducibility, noting that one should really use several replicates of the consensus heuristic. This consensus partition has confusion matrix <<>>= table(Consensus = cl_class_ids(m2), "True Classes" = Cassini$classes) @ % $ and class details as displayed in Figure~\ref{fig:Cassini-mean}: <>= plot(Cassini$x, col = cl_class_ids(m2), xlab = "", ylab = "") @ % $ \begin{figure} \centering <>= <> @ % \caption{Least Squares Consensus of the Cassini $k$-means ensemble.} \label{fig:Cassini-mean} \end{figure} This has drastically improved performance, and almost perfect recovery of the two outer shapes. In fact, \cite{cluster:Dimitriadou+Weingessel+Hornik:2002} show that almost perfect classification can be obtained by suitable combinations of different base clusterers ($k$-means, fuzzy $c$-means, and unsupervised fuzzy competitive learning). \subsection{Gordon-Vichi macroeconomic data} \citet[Table~1]{cluster:Gordon+Vichi:2001} provide soft partitions of 21 countries based on macroeconomic data for the years 1975, 1980, 1985, 1990, and 1995. These partitions were obtained using fuzzy $c$-means on measurements of the following variables: the annual per capita gross domestic product (GDP) in USD (converted to 1987 prices); the percentage of GDP provided by agriculture; the percentage of employees who worked in agriculture; and gross domestic investment, expressed as a percentage of the GDP. Table~5 in \cite{cluster:Gordon+Vichi:2001} gives 3-class consensus partitions obtained by applying their models 1, 2, and 3 and the approach in \cite{cluster:Sato+Sato:1994}. The partitions and consensus partitions are available in data sets \code{GVME} and \code{GVME\_Consensus}, respectively. We compare the results of \cite{cluster:Gordon+Vichi:2001} using GV1 dissimilarities (model 1) to ours as obtained by \code{cl\_consensus()} with method \code{"GV1"}. <<>>= data("GVME") GVME set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 3, verbose = TRUE)) @ % This results in a soft partition with average squared GV1 dissimilarity (the criterion function to be optimized by the consensus partition) of <<>>= mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) @ % We compare this to the consensus solution given in \cite{cluster:Gordon+Vichi:2001}: <<>>= data("GVME_Consensus") m2 <- GVME_Consensus[["MF1/3"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) @ % Interestingly, we are able to obtain a ``better'' solution, which however agrees with the one reported on the literature with respect to their nearest hard partitions. For the 2-class consensus partition, we obtain <<>>= set.seed(1) m1 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) @ which is slightly better than the solution reported in \cite{cluster:Gordon+Vichi:2001} <<>>= mean(cl_dissimilarity(GVME, m1, "GV1") ^ 2) m2 <- GVME_Consensus[["MF1/2"]] mean(cl_dissimilarity(GVME, m2, "GV1") ^ 2) @ but in fact agrees with it apart from rounding errors: <<>>= max(abs(cl_membership(m1) - cl_membership(m2))) @ It is interesting to compare these solutions to the Euclidean 2-class consensus partition for the GVME ensemble: <<>>= m3 <- cl_consensus(GVME, method = "GV1", control = list(k = 2, verbose = TRUE)) @ This is markedly different from the GV1 consensus partition <<>>= table(GV1 = cl_class_ids(m1), Euclidean = cl_class_ids(m3)) @ with countries <<>>= rownames(m1)[cl_class_ids(m1) != cl_class_ids(m3)] @ % classified differently, being with the ``richer'' class for the GV1 and the ``poorer'' for the Euclidean consensus partition. (In fact, all these countries end up in the ``middle'' class for the 3-class GV1 consensus partition.) \subsection{Rosenberg-Kim kinship terms data} \cite{cluster:Rosenberg+Kim:1975} describe an experiment where perceived similarities of the kinship terms were obtained from six different ``sorting'' experiments. In one of these, 85 female undergraduates at Rutgers University were asked to sort 15 English terms into classes ``on the basis of some aspect of meaning''. These partitions were printed in \citet[Table~7.1]{cluster:Rosenberg:1982}. Comparison with the original data indicates that the partition data have the ``nephew'' and ``niece'' columns interchanged, which is corrected in data set \code{Kinship82}. \citet[Table~6]{cluster:Gordon+Vichi:2001} provide consensus partitions for these data based on their models 1--3 (available in data set \code{Kinship82\_Consensus}). We compare their results using co-membership dissimilarities (model 3) to ours as obtained by \code{cl\_consensus()} with method \code{"GV3"}. <<>>= data("Kinship82") Kinship82 set.seed(1) m1 <- cl_consensus(Kinship82, method = "GV3", control = list(k = 3, verbose = TRUE)) @ % This results in a soft partition with average co-membership dissimilarity (the criterion function to be optimized by the consensus partition) of <<>>= mean(cl_dissimilarity(Kinship82, m1, "comem") ^ 2) @ % Again, we compare this to the corresponding consensus solution given in \cite{cluster:Gordon+Vichi:2001}: <<>>= data("Kinship82_Consensus") m2 <- Kinship82_Consensus[["JMF"]] mean(cl_dissimilarity(Kinship82, m2, "comem") ^ 2) @ % Interestingly, again we obtain a (this time only ``slightly'') better solution, with <<>>= cl_dissimilarity(m1, m2, "comem") table(CLUE = cl_class_ids(m1), GV2001 = cl_class_ids(m2)) @ % indicating that the two solutions are reasonably close, even though <<>>= cl_fuzziness(cl_ensemble(m1, m2)) @ % shows that the solution found by \pkg{clue} is ``softer''. \subsection{Miller-Nicely consonant phoneme confusion data} \cite{cluster:Miller+Nicely:1955} obtained the data on the auditory confusions of 16 English consonant phonemes by exposing female subjects to a series of syllables consisting of one of the consonants followed by the vowel `a' under 17 different experimental conditions. Data set \code{Phonemes} provides consonant misclassification probabilities (i.e., similarities) obtained from aggregating the six so-called flat-noise conditions in which only the speech-to-noise ratio was varied into a single matrix of misclassification frequencies. These data are used in \cite{cluster:DeSoete:1986} as an illustration of the SUMT approach for finding least squares optimal fits to dissimilarities by ultrametrics. We can reproduce this analysis as follows. <<>>= data("Phonemes") d <- as.dist(1 - Phonemes) @ % (Note that the data set has the consonant misclassification probabilities, i.e., the similarities between the phonemes.) <<>>= u <- ls_fit_ultrametric(d, control = list(verbose = TRUE)) @ % This gives an ultrametric~$u$ for which Figure~\ref{fig:Phonemes} plots the corresponding dendrogram, ``basically'' reproducing Figure~1 in \cite{cluster:DeSoete:1986}. <>= plot(u) @ % \begin{figure} \centering <>= <> @ % \caption{Dendrogram for least squares fit to the Miller-Nicely consonant phoneme confusion data.} \label{fig:Phonemes} \end{figure} We can also compare the least squares fit obtained to that of other hierarchical clusterings of $d$, e.g.\ those obtained by \code{hclust()}. The ``optimal''~$u$ has Euclidean dissimilarity <<>>= round(cl_dissimilarity(d, u), 4) @ % to $d$. For the \code{hclust()} results, we get <<>>= hclust_methods <- c("ward", "single", "complete", "average", "mcquitty") hens <- cl_ensemble(list = lapply(hclust_methods, function(m) hclust(d, m))) names(hens) <- hclust_methods round(sapply(hens, cl_dissimilarity, d), 4) @ % which all exhibit greater Euclidean dissimilarity to $d$ than $u$. (We exclude methods \code{"median"} and \code{"centroid"} as these do not yield valid hierarchies.) We can also compare the ``structure'' of the different hierarchies, e.g.\ by looking at the rate of inversions between them: <<>>= ahens <- c(L2opt = cl_ensemble(u), hens) round(cl_dissimilarity(ahens, method = "gamma"), 2) @ % \section{Outlook} \label{sec:outlook} Package~\pkg{clue} was designed as an \emph{extensible} environment for computing on cluster ensembles. It currently provides basic data structures for representing partitions and hierarchies, and facilities for computing on these, including methods for measuring proximity and obtaining consensus and ``secondary'' clusterings. Many extensions to the available functionality are possible and in fact planned (some of these enhancements were already discussed in more detail in the course of this paper). \begin{itemize} \item Provide mechanisms to generate cluster ensembles based on reweighting (assuming base clusterers allowing for case weights) the data set. \item Explore recent advances (e.g., parallelized random search) in heuristics for solving the multi-dimensional assignment problem. \item Add support for \emph{additive trees} \citep[e.g.,][]{cluster:Barthelemy+Guenoche:1991}. \item Add heuristics for finding least squares fits based on iterative projection on convex sets of constraints, see e.g.\ \cite{cluster:Hubert+Arabie+Meulman:2006} and the accompanying MATLAB code available at \url{http://cda.psych.uiuc.edu/srpm_mfiles} for using these methods (instead of SUMT approaches) to fit ultrametrics and additive trees to proximity data. \item Add an ``$L_1$ View''. Emphasis in \pkg{clue}, in particular for obtaining consensus clusterings, is on using Euclidean dissimilarities (based on suitable least squares distances); arguably, more ``robust'' consensus solutions should result from using Manhattan dissimilarities (based on absolute distances). Adding such functionality necessitates developing the corresponding structure theory for soft Manhattan median partitions. Minimizing average Manhattan dissimilarity between co-memberships and ultrametrics results in constrained $L_1$ approximation problems for the weighted medians of the co-memberships and ultrametrics, respectively, and could be approached by employing SUMTs analogous to the ones used for the $L_2$ approximations. \item Provide heuristics for obtaining \emph{hard} consensus partitions. \item Add facilities for tuning hyper-parameters (most prominently, the number of classes employed) and ``cluster validation'' of partitioning algorithms, as recently proposed by \cite{cluster:Roth+Lange+Braun:2002}, \cite{cluster:Lange+Roth+Braun:2004}, \cite{cluster:Dudoit+Fridlyand:2002}, and \cite{cluster:Tibshirani+Walther:2005}. \end{itemize} We are hoping to be able to provide many of these extensions in the near future. \subsubsection*{Acknowledgments} We are grateful to Walter B\"ohm for providing efficient C code for solving assignment problems. {\small \bibliographystyle{abbrvnat} \bibliography{cluster} } \end{document} clue/inst/CITATION0000644000175100001440000000103314366206623013337 0ustar hornikusersbibentry("Manual", other = unlist(citation(auto = meta), recursive = FALSE)) bibentry("Article", title = "A {CLUE} for {CLUster Ensembles}", author = person("Kurt", "Hornik", email = "Kurt.Hornik@R-project.org", comment = c(ORCID = "0000-0003-4198-9911")), year = 2005, journal = "Journal of Statistical Software", volume = 14, number = 12, month = "September", doi = "10.18637/jss.v014.i12" ) clue/inst/po/0000755000175100001440000000000012213262407012612 5ustar hornikusersclue/inst/po/en@quot/0000755000175100001440000000000012213262407014225 5ustar hornikusersclue/inst/po/en@quot/LC_MESSAGES/0000755000175100001440000000000012213262407016012 5ustar hornikusersclue/inst/po/en@quot/LC_MESSAGES/R-clue.mo0000644000175100001440000002064013143661614017506 0ustar hornikusersSqL/AHa?X ^ j5v2,X We V : 5O ) , / ! ;. 8j  % + )5 (_ 2 ) # * *4 _ %| )  & / I T1_*+19"X&{& *Eb%~  94.+Zy"07% ]+j(> 1,F's6/H"k?X  +572m,XW&V~:9-J0x7%C8K ")+)(H2q)#**H%e)&  2 =1H.z+1""*&M&t& #>[%w  94.$Sr&0 7" Z +g  , B !1!,K!'x!4I%R52'M+ D0.N O3,L"AS1)$=E*B#! J;-? > KQ8 PC<G(9:F&7@/H6A hard partition of %d objects into %d classes.A hard partition of %d objects.A hard partition of a cluster ensemble with %d elements into %d classes.A partition of %d objects.A soft partition (degree m = %f) of %d objects into %d classes.A soft partition (degree m = %f) of a cluster ensemble with %d elements into %d classes.AOG run: %dAOS run: %dAll clusterings must have the same number of objects.All elements must have the same number of objects.All given orders must be valid permutations.An ensemble of %d dendrogram of %d objects.An ensemble of %d dendrograms of %d objects.An ensemble of %d hierarchy of %d objects.An ensemble of %d hierarchies of %d objects.An ensemble of %d partition of %d objects.An ensemble of %d partitions of %d objects.An ensemble with %d element.An ensemble with %d elements.An object of virtual class '%s', with representation:Argument 'weights' has negative elements.Argument 'weights' has no positive elements.Argument 'weights' must be compatible with 'x'.Argument 'x' must be a partition.Arguments 'x' and 'y' must have the same number of objects.Can only determine classes of partitions or hierarchies.Can only handle hard partitions.Cannot coerce to 'cl_addtree'.Cannot coerce to 'cl_hard_partition'.Cannot compute consensus of empty ensemble.Cannot compute join of given clusterings.Cannot compute medoid of empty ensemble.Cannot compute medoid partition of empty ensemble.Cannot compute meet of given clusterings.Cannot compute prototype distances.Cannot determine how to modify prototypes.Cannot determine how to subset prototypes.Cannot determine prototypes.Cannot extract object dissimilaritiesCannot infer class ids from given object.Cannot make new predictions.Cannot mix partitions and hierarchies.Change: %gChange: u: %g L: %gClass ids must be atomic.Class ids:Criterion:Dendrograms must have the same number of objects.Generic '%s' not defined for "%s" objects.Given ensemble contains no dissimilarities.Hierarchies must have the same number of objects.Invalid agreement method '%s'.Invalid consensus method '%s'.Invalid dissimilarity method '%s'.Invalid function to modify prototypes.Invalid function to subset prototypes.Iteration: %dIteration: %d *** value: %gIteration: %d Rho: %g P: %gIteration: 0 *** value: %gIteration: 0 Rho: %g P: %gIterative projection run: %dIterative reduction run: %dJoin of given n-trees does not exist.Medoid ids:Minimum: %gNo information on dissimilarity in consensus method used.No information on exponent in consensus method used.Non-identical weights currently not supported.Not a valid membership matrix.Not a valid ultrametric.Outer iteration: %dOverall change: u: %g L: %gParameter 'p' must be in [1/2, 1].Partitions must have the same number of objects.Pclust run: %dPlotting not available for elements %s of the ensemble.SUMT run: %dStandardization is currently not supported.Term: %dUnary '%s' not defined for "%s" objects.Value '%s' is not a valid abbreviation for a fuzziness method.Wrong class.k cannot be less than the number of classes in x.x must be a matrix with nonnegative entries.x must not have more rows than columns.Project-Id-Version: clue 0.3-54 POT-Creation-Date: 2017-08-07 11:31 PO-Revision-Date: 2017-08-07 11:31 Last-Translator: Automatically generated Language-Team: none MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Language: en Plural-Forms: nplurals=2; plural=(n != 1); A hard partition of %d objects into %d classes.A hard partition of %d objects.A hard partition of a cluster ensemble with %d elements into %d classes.A partition of %d objects.A soft partition (degree m = %f) of %d objects into %d classes.A soft partition (degree m = %f) of a cluster ensemble with %d elements into %d classes.AOG run: %dAOS run: %dAll clusterings must have the same number of objects.All elements must have the same number of objects.All given orders must be valid permutations.An ensemble of %d dendrogram of %d objects.An ensemble of %d dendrograms of %d objects.An ensemble of %d hierarchy of %d objects.An ensemble of %d hierarchies of %d objects.An ensemble of %d partition of %d objects.An ensemble of %d partitions of %d objects.An ensemble with %d element.An ensemble with %d elements.An object of virtual class ‘%s’, with representation:Argument ‘weights’ has negative elements.Argument ‘weights’ has no positive elements.Argument ‘weights’ must be compatible with ‘x’.Argument ‘x’ must be a partition.Arguments ‘x’ and ‘y’ must have the same number of objects.Can only determine classes of partitions or hierarchies.Can only handle hard partitions.Cannot coerce to ‘cl_addtree’.Cannot coerce to ‘cl_hard_partition’.Cannot compute consensus of empty ensemble.Cannot compute join of given clusterings.Cannot compute medoid of empty ensemble.Cannot compute medoid partition of empty ensemble.Cannot compute meet of given clusterings.Cannot compute prototype distances.Cannot determine how to modify prototypes.Cannot determine how to subset prototypes.Cannot determine prototypes.Cannot extract object dissimilaritiesCannot infer class ids from given object.Cannot make new predictions.Cannot mix partitions and hierarchies.Change: %gChange: u: %g L: %gClass ids must be atomic.Class ids:Criterion:Dendrograms must have the same number of objects.Generic ‘%s’ not defined for "%s" objects.Given ensemble contains no dissimilarities.Hierarchies must have the same number of objects.Invalid agreement method ‘%s’.Invalid consensus method ‘%s’.Invalid dissimilarity method ‘%s’.Invalid function to modify prototypes.Invalid function to subset prototypes.Iteration: %dIteration: %d *** value: %gIteration: %d Rho: %g P: %gIteration: 0 *** value: %gIteration: 0 Rho: %g P: %gIterative projection run: %dIterative reduction run: %dJoin of given n-trees does not exist.Medoid ids:Minimum: %gNo information on dissimilarity in consensus method used.No information on exponent in consensus method used.Non-identical weights currently not supported.Not a valid membership matrix.Not a valid ultrametric.Outer iteration: %dOverall change: u: %g L: %gParameter ‘p’ must be in [1/2, 1].Partitions must have the same number of objects.Pclust run: %dPlotting not available for elements %s of the ensemble.SUMT run: %dStandardization is currently not supported.Term: %dUnary ‘%s’ not defined for "%s" objects.Value ‘%s’ is not a valid abbreviation for a fuzziness method.Wrong class.k cannot be less than the number of classes in x.x must be a matrix with nonnegative entries.x must not have more rows than columns.clue/po/0000755000175100001440000000000012213262407011635 5ustar hornikusersclue/po/R-clue.pot0000644000175100001440000001223713142031604013510 0ustar hornikusersmsgid "" msgstr "" "Project-Id-Version: clue 0.3-54\n" "POT-Creation-Date: 2017-08-07 11:31\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "Argument 'weights' must be compatible with 'x'." msgstr "" msgid "Argument 'weights' has negative elements." msgstr "" msgid "Argument 'weights' has no positive elements." msgstr "" msgid "Non-identical weights currently not supported." msgstr "" msgid "All given orders must be valid permutations." msgstr "" msgid "Iterative projection run: %d" msgstr "" msgid "Iterative reduction run: %d" msgstr "" msgid "Cannot coerce to 'cl_addtree'." msgstr "" msgid "Cannot mix partitions and hierarchies." msgstr "" msgid "All clusterings must have the same number of objects." msgstr "" msgid "Can only handle hard partitions." msgstr "" msgid "Can only determine classes of partitions or hierarchies." msgstr "" msgid "Cannot compute consensus of empty ensemble." msgstr "" msgid "AOS run: %d" msgstr "" msgid "Iteration: 0 *** value: %g" msgstr "" msgid "Iteration: %d *** value: %g" msgstr "" msgid "Minimum: %g" msgstr "" msgid "AOG run: %d" msgstr "" msgid "Parameter 'p' must be in [1/2, 1]." msgstr "" msgid "Cannot compute prototype distances." msgstr "" msgid "All elements must have the same number of objects." msgstr "" msgid "Generic '%s' not defined for \"%s\" objects." msgstr "" msgid "Wrong class." msgstr "" msgid "Plotting not available for elements %s of the ensemble." msgstr "" msgid "Value '%s' is not a valid abbreviation for a fuzziness method." msgstr "" msgid "Unary '%s' not defined for \"%s\" objects." msgstr "" msgid "Hierarchies must have the same number of objects." msgstr "" msgid "Dendrograms must have the same number of objects." msgstr "" msgid "Arguments 'x' and 'y' must have the same number of objects." msgstr "" msgid "Cannot compute meet of given clusterings." msgstr "" msgid "Cannot compute join of given clusterings." msgstr "" msgid "Join of given n-trees does not exist." msgstr "" msgid "x must be a matrix with nonnegative entries." msgstr "" msgid "x must not have more rows than columns." msgstr "" msgid "Argument 'x' must be a partition." msgstr "" msgid "Cannot compute medoid of empty ensemble." msgstr "" msgid "Cannot compute medoid partition of empty ensemble." msgstr "" msgid "Class ids:" msgstr "" msgid "Criterion:" msgstr "" msgid "Medoid ids:" msgstr "" msgid "k cannot be less than the number of classes in x." msgstr "" msgid "Cannot extract object dissimilarities" msgstr "" msgid "Cannot infer class ids from given object." msgstr "" msgid "A hard partition of %d objects." msgstr "" msgid "A partition of %d objects." msgstr "" msgid "Partitions must have the same number of objects." msgstr "" msgid "Class ids must be atomic." msgstr "" msgid "Not a valid membership matrix." msgstr "" msgid "Cannot coerce to 'cl_hard_partition'." msgstr "" msgid "No information on exponent in consensus method used." msgstr "" msgid "No information on dissimilarity in consensus method used." msgstr "" msgid "A hard partition of a cluster ensemble with %d elements into %d classes." msgstr "" msgid "A soft partition (degree m = %f) of a cluster ensemble with %d elements into %d classes." msgstr "" msgid "Cannot determine how to modify prototypes." msgstr "" msgid "Invalid function to modify prototypes." msgstr "" msgid "Cannot determine how to subset prototypes." msgstr "" msgid "Invalid function to subset prototypes." msgstr "" msgid "Pclust run: %d" msgstr "" msgid "A hard partition of %d objects into %d classes." msgstr "" msgid "A soft partition (degree m = %f) of %d objects into %d classes." msgstr "" msgid "Cannot make new predictions." msgstr "" msgid "Standardization is currently not supported." msgstr "" msgid "Cannot determine prototypes." msgstr "" msgid "Invalid consensus method '%s'." msgstr "" msgid "Invalid dissimilarity method '%s'." msgstr "" msgid "Invalid agreement method '%s'." msgstr "" msgid "SUMT run: %d" msgstr "" msgid "Iteration: 0 Rho: %g P: %g" msgstr "" msgid "Iteration: %d Rho: %g P: %g" msgstr "" msgid "Not a valid ultrametric." msgstr "" msgid "Given ensemble contains no dissimilarities." msgstr "" msgid "Outer iteration: %d" msgstr "" msgid "Change: u: %g L: %g" msgstr "" msgid "Iteration: %d" msgstr "" msgid "Term: %d" msgstr "" msgid "Change: %g" msgstr "" msgid "Overall change: u: %g L: %g" msgstr "" msgid "An object of virtual class '%s', with representation:" msgstr "" msgid "An ensemble of %d partition of %d objects." msgid_plural "An ensemble of %d partitions of %d objects." msgstr[0] "" msgstr[1] "" msgid "An ensemble of %d dendrogram of %d objects." msgid_plural "An ensemble of %d dendrograms of %d objects." msgstr[0] "" msgstr[1] "" msgid "An ensemble of %d hierarchy of %d objects." msgid_plural "An ensemble of %d hierarchies of %d objects." msgstr[0] "" msgstr[1] "" msgid "An ensemble with %d element." msgid_plural "An ensemble with %d elements." msgstr[0] "" msgstr[1] ""