From 29bfc99530b2a658bc17ed22a703d10615734c7b Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 11 Apr 2020 15:08:50 +0000 Subject: [PATCH] LazStats: Refactor KMeansUnit. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7371 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../lazstats/docs/HelpNDoc/LazStats.hnd | Bin 5976064 -> 6000640 bytes .../analysis/multivariate/kmeansunit.lfm | 95 +- .../analysis/multivariate/kmeansunit.pas | 908 +++++++++--------- 3 files changed, 496 insertions(+), 507 deletions(-) diff --git a/applications/lazstats/docs/HelpNDoc/LazStats.hnd b/applications/lazstats/docs/HelpNDoc/LazStats.hnd index e7298fe46d53e04e76922468b3a37fbd3d2cdb48..9c749bbe538ea760ecce3c95710ea04e4a14b137 100644 GIT binary patch delta 15015 zcma)j2{=_<+y6eta16&xI>uuvWS%4Qka?aZ88dc7NaT>YBorGZLzxqa4rM4IAtfpE zR8ko-4-x-$^z?sv-tT+g_q$v_d+mGO_geS5hqcyTXYa^~Ib>ws0y2f2EDVCk>Qk|* zh_I+rwWkn8d$fm;5JVb5ON-8>Nkt#3Wk%AX>1f!Xix7lVJclweLKyMEW3TynV8vz; zBRCh0j6j6ITr|i)Y6wE)od+D0Mn~Y(XMp2=hy)f+K_Ep*WhJ4Ccv@N{ftHqJorgk~ z)|P_UF^rZVNk-DzK4dUGjUbRnkyxS00ln%HIpL%VNfCm?72yk`)JS5H;F_dHGA1lQ zVuVze)j2AqBcrLMASov!tstYIqb;u>sjew4si2{$BO#4I5xL-$+jdyOBXtt{9aJ7O z2|0JO4S`jK^a}z}6Q@QRr$!d1Mjoezic_O_q(Ht|PzV4DjBwTGh5eCKSOf}A zMN)~;KoArLD&>E%17&n!W+c@ixEVoZgdl@ykW}*V%}6Q$Y5+6<4FD|w9RNK50{|lc z696*+3%~&YR)B+qW+X;qUKjMj16_vb;^}B<(`mVAifJU!1hgh~2ek>+0F^W47s|5~ zn-q8oa?~}{LGpZZVX}v0$4H-(>XY=6*diy9o`~;=^9Te4o2et!2{&)^xg+31Xk;i% zzlT{w{q`n(E%2sTJLWHMD#${wVaHWWH0<*O6G9kU#VCD4~7_^92DfZvlC;ufkZkYDEYO(>I8SktjeJF>EpHF&sBINf9#XWSkZU5gRBe z@;UM%awl>O*;}$CGHud5(t6T>bbn5N1Y7MSCp&^$PF7ywsFu8fwziC>jGVmYQFV0< zX&HHS4Q&k_4S7vC>I{+x3C+c;AUOfJ0Js6L1QjGtM-F)_M1!VmC7|L@ANkCLId zqmsA@;(0vBNJv5Wmc^qhcnIhU-nA(jT3!eX_wKJ^~F2croaIW(^$QEE4+LOzD%HJa97&(&W%@L;vS7z?0QHys*R%j3}wJECLai z$M-0YpA^gJ2CdQ|b`gV!8bmU}6X{Qp2s1zBe@uAul;0hNuz@G)l(4XM2fy?oViNu5 zJ~ZVKi1^A5enMr3fYk>Qd8ivkQAs!S0wa*J1e??>C z74i=O90m{s5F#k#3wImS+at885ot(Mq%iU(2`%Lfm~m0KgwU`kd>e&OhUxZ%u!OKp zVGQE`q&GAN1HA>}$G3zD<6B2~AED?NA#Ug@1f#1&qEbys30JE`VrhwvS@=ES#e)eC zKomd>Kpa2>Ko&p_KpsE=;3$A1fD*tl0A&Cb0961r0CfNj08Icb0Bryr zfa3tV1jS~(jy%K=Oma$J2#KtP#ZKwVF_Y+#)RCD`%+X@0n8`z+ErccsKjHi-ePtw) zp9JPyq2whCAw@#^`%@rU*nZIzOig6x`ANXkMVuJnT^Ic$gg{sQR5ZyklogEf*B3>i ztOzpx`rIf1BHMqPWy1* zuK|D|fDwQ(fC+#pfEj=}fCYdhfEA&F*V;yziXPPk(FM>>p}Gj@Q`U_rk%;{nS9E_; z{cjrXPsfbp21f4AX96{Sg96XF2Y8)19eUmDDi#q=(D$@{%*srGh9J5~I*2xs7NUuy zfzXj?2hJ=cQrV65yrgf#M0xMnt4M`N31|o)#tl0n4P!z}wu=``d{yiAv{}|n#l!TOo zsDzBDq$F1I53d}IG74iQE>}t*s3C{~LV%?SK_e{1ias*mVDoF)AaCo_2dF0tXW1|w#e_H zHD51Qs5s-DSnqcBn{Y->E88G!d-K&Gzk^%jQ6;l!xk2q{3nuf4D@SSNRD7+h+0R_n z;fiULn_y{0u=7T{l76{8b8&okH34hXVL_i+%*x|0S$d8iUJq$X~Pfg(@lNkLGfnmYttNUW5ySUDWA{p?O* z;fsy&^K-fO5rO_=Ss|8S9}vSd3(pxu>^-?A&wa5ftbg9168H1XG;2}P^N-(mKJI?N z?+rignQCzm>u$8HC4nIM506fmpL9QPTcKg{TIJ7{+;H!O5s%K3b^gvh9PS9CTcOQ+ zVX@5@1ADfqD>DQjXyR@|r%bN$=;)6z{MLxKe)G;=+}@&V&bHI;8eQ&g*Dh{vts!)! z#J@B1!lrn{D)qqx}cd?y&cLKkYJNhK}`-O$!@e4^*UtgD3 z?sd(mY=31>ZoGHEzgKZ{HK*P>{j8>yPtp6Z*|$Cmx2PQN3fFw%a@0hn?;U$A^9nD( z5Pb_#VQ_r)427qlu0C?F0W8cL7ACmZo+0%-&3bh3DN?)BN$Li6%EX zyOmbfFLfPgTSJ@Q2IDIrw{Nlue=Fr90xj)~m$%}7qmK{;qK~*+ehtGb=rxU4b2;Fu6 z5WYDS`&}oAZ$Oo8H2BoHS8wli)_!_lv+5UkuB9k`^^BtX&AAJGgJzDDT`oq&A{=JH zDf3J;ibm=0-`7@r+!C}qJ0xU1G|0|^f2(VMp;U|ZsglM?Z-3>Z7jM*Fpr`zfop(R} zUL@!qYvhnC*AQuok){vj?bnIu&-jAP$xjlC$ z3ihg&h8>-LtOUXl6RY(ruZ(8;T~2<{nwPoFOV_4qtvK(HKCB_EX7@yIcH$1c!hzfD z{?*mH%kL;HHtDfC4G+3NIKmSAN z1MT%fqyufsE>yPiuI-xoh6% zmYk33XUyIeE;6{$*+7`c{@}DX6Ef4Yy_u`>_;V`v{ms7PPDAz6BZK2zL(;`#yW7p% zJ-Zjh4P{;{?+mHt)~^cNEyVRSQm&xUF5%%v9J^n-d0L&$A*tr<)---ZQh#uk#;p3u zYaEN+qMwZvz3sIVTuc?7BQ-at@J#P-wkT^r-?(QQ56&pFSt*MaSbBIHugq3*9}V9e zXx*VZu~cc(gm06LKfb5l|3Ee9Wi4lyxWV|@iRr1t4Pz6GQCUk{>-*y15Dd>}NIG>` zuJ=iVkmHP>X56Xo?LV(u_!!tfJ{BIYeIV9+OWUsd;8RBIL!_z?JdM?U`#eyX>`U^jpQjxcP>@aFwn>+YSI*|);C>t`Z1@OvM6+wl0+g&n#? zbJL@rC{>2u&NMos)uQQVl@Gb}yxY3QadGMG%N02MQ@a7{xT0+6`bNA{PWZ~3dNOW> zfLGi(xzaYZB}Q%98GGwG5J7Kg@dTkWbmyZubwjZih_QA6>EH zEJ?~3xf8N3%x$o%Myuv(p4AB!Vzt5>cn3xZ@}RIJhw@new-qi5@U6DI?z$0h#F7?* z%JhW^tdIVem2jUAnT~+IkO`AOZ>ayJL6=g){IK4Fg-e~Sci%OK_b%@;7JABiWi2w< zvh<#u^i$vZGC3H%B>hSfa(vTd6T@j~bo|AzpBh)6uYId&7I?b4SBQ`DAvfxbFoNJ` z)%I8dcZJ=@DI{4foXV}lMM%8EbCMk94wj%J^cUG-$zgFxS`@)&!hjx0_!1ri&{DH?oXWjW{2DVcWawBXQVs#aOXX8ZyMa;6pcW@3zglPTIL9g@N8oO-rQ zBT{=Za*jolB1pdUs_?_fSze!vY$yKjNX1=`RP4Q56VXE5=(vhQFHTH{QJm=R)8kT3 zW1Rig;!$_csg()4v#4{gaWbJ$O8@k&=4t$cooq#;u$SNS^j+krb#84m#Dq?N7xPcP zY$u6Sk~&<57y6Nl!m|ozlq1S4BT7W+%|5e*0n}YZcq$^V%w& z?52tN>8t4nyp7Q`=qlNXd*%byr2T?71WPi;0_1}$2ty|bj`xQ;8>~1be2*($n8#n$ zHcZdY(HJ|^k0XiyxEwQzI+0C1&1t`3-m7&|K~qRNZ4uEr8pEH$c}oiOvaqi{HT9&` zb=%Dh!-;g#cX0#4ny1?%HBZ|jc6JYsU+{O#kG`3%eL;Te9kX&KS3FHl@i}dZTGbr` zGfKM1>z|vA2b%JGhi4iH4C0mVKWE&*Po&16hxM|Ipg#41YoE$Ga--Cw5-O#_?G=(8 z4fmuU-R#U1YcJTnA(MewQ2#N3eyJuB|DM2{j;>1fPrm2X-yK!u)^AFQ;}g&{d}b;; zmYNcG*(jxah4!iXJtJMNuP3G4WX5x|cv|#pMz5FgdFcJ*cn}lWLHDw7iC2|F6(7+s z_mCxzD^a03VF!ZV(Edx9?(gg-8J&X?kd@YSn?F`H1zoFL(`&6n3TOBr+XYn3V$cD39Qyb7KPd~Z$j>G@pz zf41gDc1B(Rd#OoQlb_$iDxWN6Z>CclAZl{S(xu3Z+6{Uy*(bE z7;$?jaK{3Fv4b&NFwt4zvSZQH;wuVPf=UyccS&c+dT?exRPBT`pIw$x{GiRp>u>ks zgB0>WYDdS#0!+L&^Uv*OUmoYIRO9RJFSYJ}ICQ@61ozV$v5eyfJ%wI5z0*zTq&ON( zSt{But?{j){IGCYncGTw9-C$b&Cb$n5x!w^bHKc*yo;Wp4K*A%8&kGv;1PX%p=rU@ z=Jjqr(sOmGccSSW1@*euGQ2*gN+pJ&-%j*xX-yboDYwyAW5ogU_Wh-eb=?nZ zT}CJGBxy|F>IyKZCI5bq!fdv&>x(0XB09!nmi3GXuFcI{pw?hZF0t<3750|pgW7of zmA8k!XtKIzT>T*zw~4-g@5T$2<*ox79_AS)%z@p{UJXc3SS|J}W*YWw3w9*wc06pZ z$^R*IpzkTELrg=tXV2o*Ba*QVq;d}x&90JK+IIMBp040CQt>W5eqm#^GR(Q$Zld}I z1xK|1@FyyFWr0uhyjg9h@hgr-Tlf5LUB+MJoJ|t_7A;tCo_};kD3$BL?Vn@^*4E~5 zMk?t?Smo!b_fV%P-;&uCFRRBSM@jF9+g#SDwwE2p-IO!V)%~Hr%b4|^CQ)~lyPuZ- z_TAE?D(LizMZMf4VOkeIK+ZFg@v5d5-|Y9JrnqmbVbe-!9G0&3=|c$o;NcVK;qJ$? z@!$MZiq5(8aHI6Z^%Mses%q6bgaGgN=T-{j6&u4vCXYkh-q2rraSjvRVzLZFrj(SH z7?nL4ys(XiFt&mJKuyPR078D?R+oJ%SM+kT%owgbWiD^!gYOE-PH<{7Y2*NQSu>zM zlTS7B2Qrl#f@(?sSda0)R_+w7h0F2YG-)&uuKHrEEAnVv^|<(Wt3xq8Jw1+3f=kgQ zLcPtB>h4eH@-5sq1te!D1-8a)eLd}FD{3&$E32|zhjbnmceih;T_%&a!Yf(DhF zDjOOY%|};W#e~Gf1uEWU6CO~oB$wehXKi2EcV$D3^zCCFao141I?E5IE5+Wie(2CA zi>!h>Ja?EI%<-1~<++iBmC&7{?o3`L8M(weuk&_ak+rl}aF(Dw4|YE+Ns-J+d+Iq> zxY#iqu6g{C9G)-8BKHwBzsU8cDn_3iYS&HgU2pz$g{tR)YD-I+L00N|ru)my_5)XO zw`y*D7MyYhbK`UDLRU&trcR{)&F+;^201~QWx0Gb`HG8pH`539if0$I2WIo~6<)g^ zzsE~iEAx>yYwvL$neM4hGIqKbs>bUr-c0=z!X#|e3<|CIvlVo7>~4CO$a2yjASq*4 zUwTi>1`g?FIkzz*Sweh`M?T)@w7F8EV~Tm>=`Ta`m1@cB`-WHxAI>2-nnhQ4g!}9o z{YbG^97SRXm4zxtOafSBxokbA$k=C^ZalUNKGC6|=dD{$7> z22iAo1rPB7Sod|TVgi+R>*q@~2ecetVgz3rSlR|8E>^cXX+0ef8JIR-V75~!dn0e$ ze~A#5affZP^q52#|HPn^Vt?8)zXM-X@v@qu1~21PZxkb)FIXE}3GOur2Oa7vcc`iZ zZMn!!Q$qXqD!G47@_ToP|GhoD4I>^N*M7ZQX33wheUrW*7mn(T9K6Guu6}Mw5ot0V zbp^5FsHWauP~snxaXzOF_w^aq`3AUNbn4#Op*v;5z&;WQkT7p1RkOC^2x0XuEXh2wTao|^Kxfe^dfO=CHe9e=S^GLpl`oL@>$^#!yTJ!HQeXCEnZEnmGTKp+O4iX|mUw3o5W&%>fssyqA9wl+atY^gtFVle zIG}KIJNaXV(UDbRE7DZeoMMvboNkV>TYH4sPP{U?s>ZVhLYi*&looUD*a0hN)mE@! zXQOM0K1LlJA@1r`UUJ>G|`;cmY;zJmRapC=g-#_*v0--JEf{y#ZB?= zHRLyPe>C2Fe!569ong~JgtzP)+mP7JZ9@55a(CZ8{o2B-p%UfMc=7(ePw}GH4Trb} zLKC*ezRho#IGkowW!S=x*d2Xj<}37Ia6pnh%^t^EJTzD6jZD{*E4QhXqvi7LHrN>` zqA?NM;-W0=WcOp2xA)5PjA^vA5q7){jIz>O5S{nBd+;~%?-&&bm>iU@`Tu2?2 zXYQMER}=Hp(>Q^c2b{w%Y_&+LPfhRRo^Sayv_v7DcAWM^Ba{TP4-(1?T0FFBq`Uw95A#};+D8QV!Eg3x)3v8PB%Xy zsMSu`8kS#@H9oK?vMQ7EL3J{8@WZp1-uI8R3U9rM%XE0O5*5ASAmz;Evd+tjqu0~7 zC_Sn<)g9HpFv_T0nub?jJXuXKiY~@9K(jf1o!^ zaJo>;K`Y85iXrscEF#Zfq)I#ut>TGobV^qWU#S4dEtHe4I{&jdeyo*`dfdg;R@ z>MdRlwL=GbznS-P=&l>z96PB$FjB&u?&VM&gMMb}iu2v3HDh^kt%Cc@RE-wf9?wma zzC;nOrfhgnl`^KXVOcKG#g|D*)kX7NXq&*&wIV$28`;r@0MzZWpsGHN^)&6x1^u3p z5D_Tf{$TlL$5LF0M$=9DJ-&%VdfLWX_ccykf;pW8dGTcB=6Jl&^~q){brExA&BO5*%!O?n zrDSfUDQ9css|g4*CG55G<;Q8MBD-3_N~uDPXC14nZl27xmh{7(ezSisZ{e5v?GO&ZFIxf}N>^+*frqBrI8@RgA7A z;6QJ0QGgj^@M?Ejq~m%80hG^2g}Cuvud9Q{Ao6&!CXisgJ)&-UaxCON9YGdt`4 zvq*dyua=F6Xb^iHl_qVP27J8m?gwukP!C#+SDo~^21Yw5O_(mI`6!E=~}qtfLC*z&TF z-|j4;?;e#_Df&v%NIlhAG^f<_{(?(a*)<1_jn;&@r(TvReb1K)pc%*mN zF^Ut*DZv&7gXQdo53{1{njz>ac0v5#qy^&|dtb<&w_2f^<5HpcxpK?KC?T8Xm{*T2 z&)_iW_^k`CbHN^;iEDPRXVubUyy>E_6-|byLy>uUq>xRqR<|NJ>NrtjN!iZ{A^$uS z%;OPU50VL5WwGix-gKnw0P(Dk?b5mL9q)8;_R~{{uUP_r{Wb z*D02!^?B4!OZ&J}ZkIhCQ`=dp8|>6=mRir2M_Gc_6&&=H%Y~6?+(ztM755IbRfO`5 z_OSJ)zD_ojjMmBRn$Isgv5o!Un=fF+W7fTfaj3hPVIIn-q$|XibI16LQyxd)0rpYC>k$y3hZ;&dTB<@P#tr(xAXHlWB7T&EYtMGgant|9oBaTOV9~ZaqMU6mfG2IO&kxT{ zoRS-FYn$y*GLMZ)`5yD6`61Zg#sn;k)UV9E?rJ`K_^=SqUIrzeI>7E7((1()bJ9%W z!Jh1@7h1G8?0kNh^Z8sgyVICM%~_jV<4qB7AZ?1FrxNNoQrV!<^tKZJbC!6F^+{}g z@Zss1o}5pTjf*YRxP~S2EmK!lS31?5DtoN+r|p0?nLS=IZ*T$}lcrzTq5W-cj(_jV z{U;0dwch>88zX`E?~NN{A>$V?nerw(zNacY%@KZeb&-jnNbs&?l-|CG>@CFwQx{0>MEPa;RTHez>GPzp^)WgT9qVOvbhDT7 zQ|Uga&wi81C&I+{s;@56)`IadCank^{J^X z8A1_4Z#ycE;Ah%c)}vM&Ik)bG>z{u^u{$ODhR%|lKkM9?E9ddp(czn-2adZtE8MQ4 z138Cj(a)5U%s|+a^|71^f0q~!ZC(Po+C{a zCZ8{R-6%1=aB{AS?(2GRK*5AyKU)b}@VPjCtE> zDe?{NiDgyKRnW^coFjV`k|1*10$(d{^j?ct{Z?K%){NgXKpshX= zvGb8zb){SSraUfUD)F$T4^1Wy7so>KGzkrDnJ3)|W{&k|CvQi-u;c?KxRJZJGn12( zV{_tcTe{83dbgKp!)Kn%uMgv#9{CP(hKxLLX}fF^v3&iA&HWP~&bPleR~~?{V9!G_ zee31c%FOTNqbz)lzpY&UyG}ZHtJ^@l@!Y45RKnPWa$AwKCpD*E-_B7ANqbS_H~c7f zceVIa_0Ffmsyz8-)Rve&I%E(ywANZ0d>s)CChj|T?ohLe@y~p@9kx)vF&6gy$@eB2 zcDeAaE~khu`SBOR!nnicB>UMSvB2r*EJKg*@CN*yJDSso5_+OZN9qG#o;S;4`-ngL zk{&0#MWvnw+@ctdFK?f}sYUWvGNl=sPQ>+A+0yg&o>ti{_h$H!zYdbfg(s>CDQ`=+ zko^El{_w`~R~<>4?#}mR@7bx5?;tR*3s2GLEh(lkNgp6>R{FX}AFTM{NKGrgY_0VY zR11N%BRkTT{?sF4&ZV8aX=HQwOf)AD1#3=KRtaO-lPrxXiGefiewjrAQ&-6l-cXb1 zpr_&XaGD-uao_kE0qphualG}%?^1cjYBBMT!TR)#RH;SN^adv7)bFJU@3KVdmvRXG z)9C2ZnvYn}kgT;m|MG2!fdXMB4SZcnit_8A4G_y=Po$kbMV>H$Gq~@XqfU`91SS_f zcO7;1Zir#$nZuH!Urb~Przs}IvW%%FUqM)P^cp>VEeS|wqxw7=w*m@_*p3;_Z)V*% zmMaOSwsw8m!XMb*An_nu(!*`vkek!YE{KO|l{t_3kKptOtb@Ljv8c9-nQz7-gNb^$ z^}n)T39k65?qKE0VnB|{acW@UN)yZ&`Z!P1&GqM;p!U&u+Zs#xkFyp%vV1N!GNKoD z9AwT^${_y|z~Ud&@f{WX@Y2yUF62w+a4Kha(S33co+(wL&q|!S7ipt+(w-@%-jzwu zMqb*aON7QVd}RunMeA|nD(PjMT^XVlLfi{N$KUqCT$ry$4vE#V&NOv0xjAgU-)FyI z+awLt)1MLqqON3Q7m!O1V|O)0fr~#e9T>|ON!UxlQ-Hy3#l(gPQctP!183_>&Ci=t zAzPFboUEw~_;xjUK@8s2=rL0qy)TuQOqAu}_WsId#n7Uj17b3N$1qPS?(9@+qDKB= z=aI^ia8tb?(}*54{!DPaab6q7)=eh_!JHV)-db!*Pk~r+_yC;`oOr|M7@Z z(yjeM%g8JmVr6n~x=~=BcRyj%T)*YnjdCa6rW=ff;N2t%%|+!y5HW^+zo+z%qYC`* zpJ$JWUq5kRjoYg9Zb0>nVmcB_dMq9G)O9c7GAT7&_PkI+nvQUPW)TWO^T4Flg6G8T z-#MCQQRPi%Y`~U>E}QQyD~N`2Tt5Hvk|}Vh-i;sI23hF63aT=bveREanVQrb)@ST< zEC{}oZ|EF)_f6}8x+^RtXuK}{Uyo2p8u@XjMH5f(NS_iiD?6R{B9AwVgy@sALVxWu zjZqqIQl*ydLeeefUu<@-xJwVvUhQgh3F#0s)gfn99I`KpFCK}}QD3*znLfy7T4p(= z-C9jnd+STAzNc4j`dr&W|2J!q>Cu>!T6x}HVa>1?5Ak&O_++HDUM$>pOD(t*wD_#- zoUXIOWG1$(Nq=~l0_g3^l>EF`@N+Hk*oA42N=;>f zPFsUeIXsW&y!W+thrQV^3Ho&1H7{K7_VJ6l@X2m!Ex9e9@rkl_aaeb4``L#dvG2;> z@uAc-^NyBzyYzLWSETK|F7InN)7sxuhDR_@_N8I7y=fV5;^_%Q8 z{BCro7$;8aN^Op8aAsBow4^b!8=N1An&PMH{E$qIH&p8Ae@dWK_pu4POKZkXuMv7J z@jf}*nRc=hA{-RO1CRM%kqbN)=`Cz)D$06@lxS-TY8!i2D_o3vq$lEFl?1G^sMbaBzign5K-oZE&^gEx=J~9}eOLs%d5(k5Kg^50U19~b^|Y-Q?SAu*X(KGSY35JwE^_GP`GU{Lmj zLigKt18oF?5^)&Beu97o=k_^W!F9g|=Ik@Wz-NyzFvDsN#}2^nPm(jkeIgEw@Q$%E z6-+y=MGn(CvQxo{Njw}d_L@B!-qY0~hfjXfq<~YB?5W@%V=QQRcNNfxMqwc8^s86m zc)%TuFrdJo{!$XAPT=Fj_yZkqfGY?%f#@8f6^Pagfuq7{Sr7qmsy{ss!=Ixf+At74 z`whjy>JFXX7Xw}a!fuclB!txi-O$VFv%`7!C`iHAI8iB->~NRUF?u*s*Hi+2U7}9T za(chhAmDqVmx-!jAt^ZO8Xqei(HFmb=mE3{f*BUfSYVqDR%ZCAoIWWF(E&t*{)!4$ zz~Tq_XBg?Qz-mUy6fo6-85-pZ20)C5`!*IBP85 zNF6eUEPytekRfCRN|ul|WDe;8>hXOMSqZGnZy9x9PG`s;?p?NEvQys|lZ2!pIUtS& z4Vi*JLtt<0elzNzDX{wl|A`bqND?{<$pZ+1J8Q^fpHm7_fQVUW4DQ7MhY(f>s{=Vgs_^wyh-eV5f~Q>RL4Rg z`pKD;?8CDH?crFZlkaJQ%llE6>ER3E5p#YDE z(X+$Ge7~q@5=lswNW#FU_^e6ci7@(u_@n$MeZMDvO1guj z@SJYpVI@;?uzh|tpU^N zf0Cv4C!AjjNP&DM&LIDqjM9Jb$N+N_>#LTv1RKS5N|5m~@TNEGw}lQJI=$ zQg-rdK$A0#;;uScny531R~-xeLx-F`)R}6usmPoWjm#uU%(5dj_Q&td`?~kMd(JyI z9J|fJ-My@NgtUqf>1c~Nm9A*I1r(pK4mSIQ@3xxdW5rQIfI)atjmeKs6RIC5(G`N6+L^$U3d9~t4>bA2 zCZE*glbd`>lTSVFvn)JHWghCYT+keBhNV*dPOVnHRD$wVxk|c3JGT{Buh|G8(SWK> zq^d1IA(Uz@fxWl163AoL0BFpb1?j^3phPqT zInWbmC`v-ZcqcOoe=bp*Nit(Z2TPBhVte1_(N0>HYejJvtXJbIScCezY6#bbWsE7i zm2vVhd5UyiDigo5E)t((ckS=k<1LEXOgGTPtqJ92V%!C?8b02U_J)e{-mwJ6G5BJ4 zz6pmuGfeOe7+D~{m$pV-r331R-+IxCNK` zjJKh=&Qk!*lx6bVe&cfnD+X`?rfi8NkkQ)jcEUFz#=sX+pl1L}&mZ7He`qwqyx;I_ z{-4GQW#wSp3^-fKoUMNvWzb?_4KT^8*NMwteIbr}{xW(fRNQo@z>&TT6XH*g&x*?> zt&hLA#qkuzxNCH+9lmzN+L7-ji!^7Olw2`P$(DQNeey!tkSI&Z0oVL#P zIHN6RF{6j-J%bs_6ems~?R@iTI>)0-l!cx|9y9@Eqa5@Unuxq;63RuBQ69=iPopWQ08K?cGz}G^ z>1YNjLd9q%n#CiXB@Hp!0Yb>1!Gv_k3i-Vb_E0z>m8reDX?4i;WPna*SNW=te+m`z)qZpDtkgKiXViR;_;=n0=O1sa|CGyqsE1{z|PMG$CJE14^AglY8s@sS2if z3|~|4w;#ZrVZF07AFf1$W1!brT1{n`=_;KnW#@Tv^C0{xb4A)+rD!$^pgE`vm7}?6 z9;!gkpi18Es+vDVwX1$&e@(x}^-$GEkD@hl|I(^cNr{RUCibwM=wY4M!ZxCX`Td>M zGUX#1tFBvHdrQNS@Wv`MA3e*%8-r^FmFX*qJx5=O+wDvG@W#A`q(FeG`B*|iR6-|F zmD+Mhfc%?;ww*!q(e|gpxt+m$=#JuLPBeH)rCLAH`lTI^wSWzU?t{*;eAymnP#$a` zjtw+j=KTkQwjVk3)a+9J%^sgD21P#g>6&u_F2l*BgK+x~cM4y!$GPDDkt;0NY=pqK d(dx8EOW8~L{%JMCD8F7 0) do - begin - for i := 0 to VarList.Items.Count - 1 do - begin - if (VarList.Selected[i]) then - begin - VarList.Items.Delete(i); - count := count - 1; - end; - end; - end; - VarOutBtn.Enabled := true; +procedure TKMeansFrm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; end; procedure TKMeansFrm.VarOutBtnClick(Sender: TObject); -VAR index : integer; - cellstring : string; +var + i: integer; begin - index := ListBox1.ItemIndex; - cellstring := ListBox1.Items.Strings[index]; - VarList.Items.Add(cellstring); - ListBox1.Items.Delete(index); + i := 0; + while i < SelList.Items.Count do + begin + if SelList.Selected[i] then + begin + VarList.Items.Add(SelList.Items[i]); + SelList.Items.Delete(i); + i := 0; + end else + i := i + 1; + end; + UpdateBtnStates; end; procedure TKMeansFrm.FormActivate(Sender: TObject); @@ -152,12 +153,11 @@ begin if FAutoSized then exit; - w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); HelpBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w; - CancelBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w; - ReturnBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; Constraints.MinWidth := Width; Constraints.MinHeight := Height; @@ -168,8 +168,6 @@ end; procedure TKMeansFrm.FormCreate(Sender: TObject); begin Assert(OS3MainFrm <> nil); - if OutputFrm = nil then - Application.CreateForm(TOutputFrm, OutputFrm); end; procedure TKMeansFrm.FormShow(Sender: TObject); @@ -185,257 +183,250 @@ begin end; procedure TKMeansFrm.AllBtnClick(Sender: TObject); -VAR - index, noitems : integer; - cellstring : string; +var + index: integer; + cellstring: string; begin - noitems := VarList.Items.Count; - for index := 0 to noitems - 1 do - begin - cellstring := VarList.Items.Strings[index]; - ListBox1.Items.Add(cellstring); - end; - VarList.Clear; - VarOutBtn.Enabled := true; + for index := 0 to VarList.Items.Count - 1 do + begin + cellstring := VarList.Items[index]; + SelList.Items.Add(cellstring); + end; + VarList.Clear; + UpdateBtnStates; end; procedure TKMeansFrm.ComputeBtnClick(Sender: TObject); VAR i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer; - center, itemp : integer; + center: integer; IC1, IC2, NC, NCP, ITRAN, LIVE, ColSelected : IntDyneVec; A, C : DblDyneMat; - D, AN1, AN2, WSS, DT : DblDyneVec; + D, AN1, AN2, WSS: DblDyneVec; cellstring: string; outline : string; - strval : string; varlabels, rowlabels : StrDyneVec; Mean, stddev : double; -label cleanup; - + lReport: TStrings; begin - Ncols := ListBox1.Items.Count; - if (Ncols <= 0) then - begin - ShowMessage('ERROR! No variables selected to cluster.'); - exit; - end; + Ncols := SelList.Items.Count; + if (Ncols <= 0) then + begin + MessageDlg('No variables selected to cluster.', mtError, [mbOK], 0); + exit; + end; - N := Ncols; - M := NoCases; - K := StrToInt(NoClustersEdit.Text); - IFAULT := 0; - ITER := StrToInt(ItersEdit.Text); + if NoClustersEdit.Text = '' then + begin + NoClustersEdit.SetFocus; + MessageDlg('You must enter the desired number of clusters.', mtError, [mbOK], 0); + exit; + end; + if not TryStrToInt(NoClustersEdit.Text, K) or (K <= 0) then + begin + NoClustersEdit.SetFocus; + MessageDlg('You must enter the desired number of clusters as a positive value.', mtError, [mbOK], 0); + exit; + end; - SetLength(varlabels,Ncols); - SetLength(rowlabels,NoCases); - SetLength(ColSelected,Ncols); - SetLength(A,M+1,N+1); - SetLength(C,K+1,N+1); - SetLength(D,M+1); - SetLength(AN1,K+1); - SetLength(AN2,K+1); - SetLength(WSS,K+1); - SetLength(DT,3); - SetLength(IC1,M+1); - SetLength(IC2,M+1); - SetLength(NC,K+1); - SetLength(NCP,K+1); - SetLength(ITRAN,K+1); - SetLength(LIVE,K+1); + if ItersEdit.Text = '' then + begin + ItersEdit.SetFocus; + MessageDlg('This field cannot be empty.', mtError, [mbOK], 0); + exit; + end; + if not TryStrToInt(ItersEdit.Text, ITER) or (ITER <= 0) then + begin + ItersEdit.SetFocus; + MessageDlg('Invalid input.', mtError, [mbOK], 0); + exit; + end; - if (K <= 0) then - begin - ShowMessage('ERROR! You must enter the desired number of clusters.'); - goto cleanup; - end; + N := Ncols; + M := NoCases; + IFAULT := 0; - // initialize arrays - for i := 1 to K do - begin - AN1[i] := 0.0; - AN2[i] := 0.0; - WSS[i] := 0.0; - NC[i] := 0; - NCP[i] := 0; - ITRAN[i] := 0; - LIVE[i] := 0; - for j := 1 to N do C[i,j] := 0.0; - end; - for i := 1 to M do - begin - IC1[i] := 0; - IC2[i] := 0; - D[i] := 0.0; - end; + SetLength(varlabels,Ncols); + SetLength(rowlabels,NoCases); + SetLength(ColSelected,Ncols); + SetLength(A,M+1,N+1); + SetLength(C,K+1,N+1); + SetLength(D,M+1); + SetLength(AN1,K+1); + SetLength(AN2,K+1); + SetLength(WSS,K+1); + SetLength(IC1,M+1); + SetLength(IC2,M+1); + SetLength(NC,K+1); + SetLength(NCP,K+1); + SetLength(ITRAN,K+1); + SetLength(LIVE,K+1); - //Get labels and columns of selected variables - for i := 0 to Ncols - 1 do - begin - cellstring := ListBox1.Items.Strings[i]; - for j := 0 to NoVariables - 1 do + // initialize arrays + for i := 1 to K do + begin + AN1[i] := 0.0; + AN2[i] := 0.0; + WSS[i] := 0.0; + NC[i] := 0; + NCP[i] := 0; + ITRAN[i] := 0; + LIVE[i] := 0; + for j := 1 to N do C[i,j] := 0.0; + end; + for i := 1 to M do + begin + IC1[i] := 0; + IC2[i] := 0; + D[i] := 0.0; + end; + + //Get labels and columns of selected variables + for i := 0 to Ncols - 1 do + begin + cellstring := SelList.Items.Strings[i]; + for j := 0 to NoVariables - 1 do + begin + if (cellstring = OS3MainFrm.DataGrid.Cells[j+1,0]) then + begin + varlabels[i] := cellstring; + ColSelected[i] := j+1; + end; + end; + end; + + // Get labels of rows + for i := 0 to NoCases - 1 do + rowlabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1]; + + // read the data + for i := 1 to M do + begin + if not GoodRecord(i, N, ColSelected) then continue; + for j := 1 to N do + begin + col := ColSelected[j-1]; + A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]); + end; + end; + + lReport := TStringList.Create; + try + lReport.Add('K-MEANS CLUSTERING'); + lReport.Add('Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1'); + lReport.Add(''); + lReport.Add('File: %s', [OS3MainFrm.FileNameEdit.Text]); + lReport.Add('No. Cases: %d, No. Variables: %d, No. Clusters: %d',[M, N, K]); + lReport.Add(''); + + // transform to z scores if needed + if StdChkBox.Checked then + begin + for j := 1 to N do + begin + Mean := 0.0; + stddev := 0.0; + for i := 1 to M do begin - if (cellstring = OS3MainFrm.DataGrid.Cells[j+1,0]) then - begin - varlabels[i] := cellstring; - ColSelected[i] := j+1; - end; + Mean := Mean + A[i,j]; + stddev := stddev + sqr(A[i,j]); end; - end; - - // Get labels of rows - for i := 0 to NoCases - 1 do rowlabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1]; - - // read the data - for i := 1 to M do - begin - if (NOT GoodRecord(i,N,ColSelected)) then continue; - for j := 1 to N do - begin - col := ColSelected[j-1]; - A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]); - end; - end; - - OutputFrm.RichEdit.Clear; - OutputFrm.RichEdit.Lines.Add('K-Means Clustering. Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1'); - OutputFrm.RichEdit.Lines.Add(''); - outline := format('File := %s',[OS3MainFrm.FileNameEdit.Text]); - OutputFrm.RichEdit.Lines.Add(outline); - outline := format('No. Cases := %d, No. Variables := %d, No. Clusters := %d',[M,N,K]); - OutputFrm.RichEdit.Lines.Add(outline); - OutputFrm.RichEdit.Lines.Add(''); - - // transform to z scores if needed - if (StdChkBox.Checked = true) then - begin - for j := 1 to N do + stddev := stddev - Mean * Mean / M; + stddev := stddev / (M - 1); + Mean := Mean / M; + if DescChkBox.Checked then + lReport.Add('Mean: %8.3f, Std.Dev.: %8.3f for %s', [Mean, stddev, varlabels[j-1]]); + for i := 1 to M do begin - Mean := 0.0; - stddev := 0.0; - for i := 1 to M do - begin - Mean := Mean + A[i,j]; - stddev := stddev + (A[i,j] * A[i,j]); - end; - stddev := stddev - Mean * Mean / M; - stddev := stddev / (M - 1); - Mean := Mean / M; - if (DescChkBox.Checked) then - begin - outline := format('Mean := %8.3f, Std.Dev. := %8.3f for %s',[Mean,stddev,varlabels[j-1]]); - OutputFrm.RichEdit.Lines.Add(outline); - end; - for i := 1 to M do - begin - A[i,j] := (A[i,j] - Mean) / stddev; - if (RepChkBox.Checked = true) then - begin - col := ColSelected[j-1]; - outline := format('%8.5f',[A[i,j]]); - OS3MainFrm.DataGrid.Cells[col,i] := outline; - end; - end; + A[i,j] := (A[i,j] - Mean) / stddev; + if RepChkBox.Checked then + begin + col := ColSelected[j-1]; + OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.5f', [A[i,j]]); + end; end; - end; + end; + end; - // Now enter initial points - for L := 1 to K do - begin - center := 1 + (L-1) * (M div K); // initial cluster center - for j := 1 to N do C[L,j] := A[center,j]; - end; + // Now enter initial points + for L := 1 to K do + begin + center := 1 + (L-1) * (M div K); // initial cluster center // wp: why not ((L-1)*M) div K + for j := 1 to N do + C[L, j] := A[center, j]; + end; - // do analysis - KMNS(A,M,N,C,K,IC1,IC2,NC,AN1,AN2,NCP,D,ITRAN,LIVE,ITER,WSS,IFAULT); + // do analysis + KMNS(A,M,N,C,K,IC1,IC2,NC,AN1,AN2,NCP,D,ITRAN,LIVE,ITER,WSS,IFAULT); - // show results + // show results - // sort subjects by cluster - for i := 1 to M do IC2[i] := i; // store ids in here - for i := 1 to M - 1 do - begin - for j := i+1 to M do - begin - if (IC1[i] > IC1[j]) then // swap these clusters and ids - begin - itemp := IC1[i]; - IC1[i] := IC1[j]; - IC1[j] := itemp; - itemp := IC2[i]; - IC2[i] := IC2[j]; - IC2[j] := itemp; - end; - end; - end; + // sort subjects by cluster + for i := 1 to M do + IC2[i] := i; // store ids in here + for i := 1 to M - 1 do + begin + for j := i+1 to M do + begin + if (IC1[i] > IC1[j]) then // swap these clusters and ids + begin + Exchange(IC1[i], IC1[j]); + Exchange(IC2[i], IC2[j]); + end; + end; + end; - OutputFrm.RichEdit.Lines.Add(''); - OutputFrm.RichEdit.Lines.Add('NUMBER OF SUBJECTS IN EACH CLUSTER'); - for i := 1 to K do - begin - outline := format('Cluster := %d with %d cases.',[i,NC[i]]); - OutputFrm.RichEdit.Lines.Add(outline); - end; + lReport.Add(''); + lReport.Add('NUMBER OF SUBJECTS IN EACH CLUSTER'); + for i := 1 to K do + lReport.Add('Cluster %d with %d cases.', [i, NC[i]]); - OutputFrm.RichEdit.Lines.Add(''); - OutputFrm.RichEdit.Lines.Add('PLACEMENT OF SUBJECTS IN CLUSTERS'); - OutputFrm.RichEdit.Lines.Add('CLUSTER SUBJECT'); - for i := 1 to M do - begin - outline := format(' %3d %3d',[IC1[i],IC2[i]]); - OutputFrm.RichEdit.Lines.Add(outline); - end; + lReport.Add(''); + lReport.Add('PLACEMENT OF SUBJECTS IN CLUSTERS'); + lReport.Add('CLUSTER SUBJECT'); + for i := 1 to M do + lReport.Add(' %3d %3d', [IC1[i], IC2[i]]); - OutputFrm.RichEdit.Lines.Add(''); - OutputFrm.RichEdit.Lines.Add('AVERAGE VARIABLE VALUES BY CLUSTER'); - outline := ' VARIABLES'; - OutputFrm.RichEdit.Lines.Add(outline); - outline := 'CLUSTER'; - for j := 1 to N do - begin - strval := format(' %3d ',[j]); - outline := outline + strval; - end; - OutputFrm.RichEdit.Lines.Add(outline); - OutputFrm.RichEdit.Lines.Add(' '); - for i := 1 to K do - begin - outline := format(' %3d ',[i]); - for j := 1 to N do - begin - strval := format('%5.2f ',[C[i,j]]); - outline := outline + strval; - end; - OutputFrm.RichEdit.Lines.Add(outline); - end; - OutputFrm.RichEdit.Lines.Add(''); - OutputFrm.RichEdit.Lines.Add('WITHIN CLUSTER SUMS OF SQUARES'); - for i := 1 to K do - begin - outline := format('Cluster %d := %6.3f',[i,WSS[i]]); - OutputFrm.RichEdit.Lines.Add(outline); - end; + lReport.Add(''); + lReport.Add('AVERAGE VARIABLE VALUES BY CLUSTER'); + lReport.Add(' VARIABLES'); + outline := 'CLUSTER'; + for j := 1 to N do + outline := outline + Format(' %3d ',[j]); + lReport.Add(outline); + lReport.Add(' '); + for i := 1 to K do + begin + outline := format(' %3d ',[i]); + for j := 1 to N do + outline := outline + Format('%5.2f ', [C[i,j]]); + lReport.Add(outline); + end; + lReport.Add(''); + lReport.Add('WITHIN CLUSTER SUMS OF SQUARES'); + for i := 1 to K do + lReport.Add('Cluster %d: %6.3f', [i, WSS[i]]); - OutputFrm.ShowModal; + DisplayReport(lReport); - // cleanup -cleanup: - LIVE := nil; - ITRAN := nil; - NCP := nil; - NC := nil; - IC2 := nil; - IC1 := nil; - DT := nil; - WSS := nil; - AN2 := nil; - AN1 := nil; - D := nil; - C := nil; - A := nil; - ColSelected := nil; - rowlabels := nil; - varlabels := nil; + finally + lReport.Free; + LIVE := nil; + ITRAN := nil; + NCP := nil; + NC := nil; + IC2 := nil; + IC1 := nil; + WSS := nil; + AN2 := nil; + AN1 := nil; + D := nil; + C := nil; + A := nil; + ColSelected := nil; + rowlabels := nil; + varlabels := nil; + end; end; procedure TKMeansFrm.KMNS(VAR A : DblDyneMat; M, N : integer; @@ -445,188 +436,194 @@ procedure TKMeansFrm.KMNS(VAR A : DblDyneMat; M, N : integer; VAR NCP : IntDyneVec; VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec; ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer); +const + BIG = 1.0E30; + ZERO = 0.0; + ONE = 1.0; VAR - DT : array[0..2] of double; - BIG : double; - ZERO : double; - ONE : double; - DA, DB, DC, TEMP, AA : double; - L, II, INDX, I, J, IL, IJ : integer; -label cont50, cont40, cont150; + DT: array[0..2] of double; + DA, DB, DC, TEMP, AA: double; + L, II, INDX, I, J, IL, IJ: integer; + +label + cont50, cont40, cont150; begin - // SUBROUTINE KMNS(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, - // * ITRAN, LIVE, ITER, WSS, IFAULT) - // - // ALGORITHM AS 136 APPL. STATIST. (1979) VOL.28, NO.1 - // Divide M points in N-dimensional space into K clusters so that - // the within cluster sum of squares is minimized. - // - // INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) - // REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), WSS(K), DT(2) - // REAL ZERO, ONE - // - // Define BIG to be a very large positive number - // - // DATA BIG /1.E30/, ZERO /0.0/, ONE /1.0/ - // - BIG := 1.0e30; - ZERO := 0.0; - ONE := 1.0; - IFAULT := 3; - if ((K <= 1) or (K >= M)) then - begin - ShowMessage('The no. of clusters must be less than the no. of variables.'); - exit; - end; + // SUBROUTINE KMNS(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, + // * ITRAN, LIVE, ITER, WSS, IFAULT) + // + // ALGORITHM AS 136 APPL. STATIST. (1979) VOL.28, NO.1 + // Divide M points in N-dimensional space into K clusters so that + // the within cluster sum of squares is minimized. + // + // INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K), LIVE(K) + // REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), WSS(K), DT(2) + // REAL ZERO, ONE + // + // Define BIG to be a very large positive number + // + // DATA BIG /1.E30/, ZERO /0.0/, ONE /1.0/ + // + IFAULT := 3; + if (K <= 1) or (K >= M) then + begin + MessageDlg('The no. of clusters must be less than the no. of variables.', mtError, [mbOK], 0); + exit; + end; - // For each point I, find its two closest centres, IC1(I) and - // IC2(I). Assign it to IC1(I). - // - for I := 1 to M do - begin - IC1[I] := 1; - IC2[I] := 2; - for IL := 1 to 2 do - begin - DT[IL] := ZERO; - for J := 1 to N do - begin - DA := A[I,J] - C[IL,J]; - DT[IL] := DT[IL] + (DA * DA); //(squared difference for this comparison) - end; // 10 CONTINUE - end; // 10 CONTINUE - if (DT[1] > DT[2]) then // THEN swap - begin - IC1[I] := 2; - IC2[I] := 1; - TEMP := DT[1]; - DT[1] := DT[2]; - DT[2] := TEMP; - end; // END IF - for L := 3 to K do // (remaining clusters) - begin - DB := ZERO; - for J := 1 to N do // (variables) - begin - DC := A[I,J] - C[L,J]; - DB := DB + DC * DC; - if (DB >= DT[2]) then goto cont50; - end; - if (DB < DT[1]) then goto cont40; - DT[2] := DB; - IC2[I] := L; - goto cont50; -cont40: DT[2] := DT[1]; - IC2[I] := IC1[I]; - DT[1] := DB; - IC1[I] := L; -cont50: end; - end; // 50 CONTINUE (next case) - - // Update cluster centres to be the average of points contained - // within them. - // - for L := 1 to K do // (clusters) - begin - NC[L] := 0; - for J := 1 to N do C[L,J] := ZERO; //(initialize clusters) - end; - for I := 1 to M do // (subjects) - begin - L := IC1[I]; // which cluster the Ith case is in - NC[L] := NC[L] + 1; // no. in the cluster L - for J := 1 to N do C[L,J] := C[L,J] + A[I,J]; // sum of var. values in the cluster L - end; - - // Check to see if there is any empty cluster at this stage - // - for L := 1 to K do - begin - if (NC[L] = 0) then - begin - IFAULT := 1; - exit; - end; - AA := NC[L]; - for J := 1 to N do C[L,J] := C[L,J] / AA; // average the values in the cluster - - // Initialize AN1, AN2, ITRAN & NCP - // AN1(L) := NC(L) / (NC(L) - 1) - // AN2(L) := NC(L) / (NC(L) + 1) - // ITRAN(L) := 1 if cluster L is updated in the quick-transfer stage, - // := 0 otherwise - // In the optimal-transfer stage, NCP(L) stores the step at which - // cluster L is last updated. - // In the quick-transfer stage, NCP(L) stores the step at which - // cluster L is last updated plus M. - // - AN2[L] := AA / (AA + ONE); - AN1[L] := BIG; - if (AA > ONE) then AN1[L] := AA / (AA - ONE); - ITRAN[L] := 1; - NCP[L] := -1; - end; - INDX := 0; - for IJ := 1 to ITER do - begin - // - // In this stage, there is only one pass through the data. Each - // point is re-allocated, if necessary, to the cluster that will - // induce the maximum reduction in within-cluster sum of squares. - // - OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, LIVE, INDX); - // - // Stop if no transfer took place in the last M optimal transfer - // steps. - // - if (INDX = M) then goto cont150; - // - // Each point is tested in turn to see if it should be re-allocated - // to the cluster to which it is most likely to be transferred, - // IC2(I), from its present cluster, IC1(I). Loop through the - // data until no further change is to take place. - // - QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, INDX); - // - // If there are only two clusters, there is no need to re-enter the - // optimal transfer stage. - // - if (K = 2) then goto cont150; - // - // NCP has to be set to 0 before entering OPTRA. - // - for L := 1 to K do NCP[L] := 0; - end; - // - // Since the specified number of iterations has been exceeded, set - // IFAULT := 2. This may indicate unforeseen looping. - // - IFAULT := 2; - // - // Compute within-cluster sum of squares for each cluster. - // -cont150: - for L := 1 to K do - begin - WSS[L] := ZERO; - for J := 1 to N do C[L,J] := ZERO; - end; - for I := 1 to M do - begin - II := IC1[I]; - for J := 1 to N do C[II,J] := C[II,J] + A[I,J]; - end; + // For each point I, find its two closest centres, IC1(I) and + // IC2(I). Assign it to IC1(I). + // + for I := 1 to M do + begin + IC1[I] := 1; + IC2[I] := 2; + for IL := 1 to 2 do + begin + DT[IL] := ZERO; for J := 1 to N do begin - for L := 1 to K do C[L,J] := C[L,J] / (NC[L]); - for I := 1 to M do - begin - II := IC1[I]; - DA := A[I,J] - C[II,J]; - WSS[II] := WSS[II] + DA * DA; - end; - end; // 190 CONTINUE + DA := A[I,J] - C[IL,J]; + DT[IL] := DT[IL] + (DA * DA); //(squared difference for this comparison) + end; // 10 CONTINUE + end; // 10 CONTINUE + + if (DT[1] > DT[2]) then // THEN swap + begin + IC1[I] := 2; + IC2[I] := 1; + TEMP := DT[1]; + DT[1] := DT[2]; + DT[2] := TEMP; + end; // END IF + + for L := 3 to K do // (remaining clusters) + begin + DB := ZERO; + for J := 1 to N do // (variables) + begin + DC := A[I,J] - C[L,J]; + DB := DB + DC * DC; + if (DB >= DT[2]) then goto cont50; + end; + if (DB < DT[1]) then goto cont40; + DT[2] := DB; + IC2[I] := L; + goto cont50; + +cont40: + DT[2] := DT[1]; + IC2[I] := IC1[I]; + DT[1] := DB; + IC1[I] := L; + +cont50: + end; + end; // 50 CONTINUE (next case) + + // Update cluster centres to be the average of points contained + // within them. + // + for L := 1 to K do // (clusters) + begin + NC[L] := 0; + for J := 1 to N do C[L,J] := ZERO; //(initialize clusters) + end; + for I := 1 to M do // (subjects) + begin + L := IC1[I]; // which cluster the Ith case is in + NC[L] := NC[L] + 1; // no. in the cluster L + for J := 1 to N do C[L,J] := C[L,J] + A[I,J]; // sum of var. values in the cluster L + end; + + // Check to see if there is any empty cluster at this stage + // + for L := 1 to K do + begin + if (NC[L] = 0) then + begin + IFAULT := 1; + exit; + end; + AA := NC[L]; + for J := 1 to N do C[L,J] := C[L,J] / AA; // average the values in the cluster + + // Initialize AN1, AN2, ITRAN & NCP + // AN1(L) := NC(L) / (NC(L) - 1) + // AN2(L) := NC(L) / (NC(L) + 1) + // ITRAN(L) := 1 if cluster L is updated in the quick-transfer stage, + // := 0 otherwise + // In the optimal-transfer stage, NCP(L) stores the step at which + // cluster L is last updated. + // In the quick-transfer stage, NCP(L) stores the step at which + // cluster L is last updated plus M. + // + AN2[L] := AA / (AA + ONE); + AN1[L] := BIG; + if (AA > ONE) then AN1[L] := AA / (AA - ONE); + ITRAN[L] := 1; + NCP[L] := -1; + end; + + INDX := 0; + for IJ := 1 to ITER do + begin + // + // In this stage, there is only one pass through the data. Each + // point is re-allocated, if necessary, to the cluster that will + // induce the maximum reduction in within-cluster sum of squares. + // + OPTRA(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, LIVE, INDX); + // + // Stop if no transfer took place in the last M optimal transfer steps. + // + if (INDX = M) then goto cont150; + // + // Each point is tested in turn to see if it should be re-allocated + // to the cluster to which it is most likely to be transferred, + // IC2(I), from its present cluster, IC1(I). Loop through the + // data until no further change is to take place. + // + QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, INDX); + // + // If there are only two clusters, there is no need to re-enter the + // optimal transfer stage. + // + if (K = 2) then goto cont150; + // + // NCP has to be set to 0 before entering OPTRA. + // + for L := 1 to K do NCP[L] := 0; + end; + // + // Since the specified number of iterations has been exceeded, set + // IFAULT := 2. This may indicate unforeseen looping. + // + IFAULT := 2; + // + // Compute within-cluster sum of squares for each cluster. + // +cont150: + for L := 1 to K do + begin + WSS[L] := ZERO; + for J := 1 to N do C[L,J] := ZERO; + end; + for I := 1 to M do + begin + II := IC1[I]; + for J := 1 to N do C[II,J] := C[II,J] + A[I,J]; + end; + for J := 1 to N do + begin + for L := 1 to K do C[L,J] := C[L,J] / (NC[L]); + for I := 1 to M do + begin + II := IC1[I]; + DA := A[I,J] - C[II,J]; + WSS[II] := WSS[II] + DA * DA; + end; + end; // 190 CONTINUE end; @@ -898,6 +895,13 @@ cont60: goto cont10; end; +procedure TKMeansFrm.UpdateBtnStates; +begin + VarInBtn.Enabled := AnySelected(VarList); + VarOutBtn.Enabled := AnySelected(SelList); + AllBtn.Enabled := VarList.Items.Count > 0; +end; + initialization {$I kmeansunit.lrs}