From 3f97dee3979257aa414f6fc542481020858c28d1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 11 Apr 2020 10:56:59 +0000 Subject: [PATCH] LazStats: Refactor AvgLinkUnit. Add data file cansas_rotated.laz. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7370 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/lazstats/data/cansas_rotated.laz | 289 ++++++++++++++++++ .../lazstats/docs/HelpNDoc/LazStats.hnd | Bin 5935104 -> 5976064 bytes .../analysis/multivariate/avglinkunit.lfm | 64 ++-- .../analysis/multivariate/avglinkunit.pas | 240 +++++++-------- 4 files changed, 433 insertions(+), 160 deletions(-) create mode 100644 applications/lazstats/data/cansas_rotated.laz diff --git a/applications/lazstats/data/cansas_rotated.laz b/applications/lazstats/data/cansas_rotated.laz new file mode 100644 index 000000000..c53f7d4ca --- /dev/null +++ b/applications/lazstats/data/cansas_rotated.laz @@ -0,0 +1,289 @@ +6 +20 +CASE 1 +VARIABLE 1 +5 +F +3 +99999 +L +CASE 2 +VARIABLE 2 +5 +F +3 +99999 +L +CASE 3 +VARIABLE 3 +6 +F +4 +99999 +L +CASE 4 +VARIABLE 4 +5 +F +3 +99999 +L +CASE 5 +VARIABLE 5 +5 +F +3 +99999 +L +CASE 6 +VARIABLE 6 +5 +F +3 +99999 +L +CASE 7 +VARIABLE 7 +5 +F +3 +99999 +L +CASE 8 +VARIABLE 8 +5 +F +3 +99999 +L +CASE 9 +VARIABLE 9 +5 +F +3 +99999 +L +CASE 10 +VARIABLE 10 +6 +F +4 +99999 +L +CASE 11 +VARIABLE 11 +5 +F +3 +99999 +L +CASE 12 +VARIABLE 12 +6 +F +4 +99999 +L +CASE 13 +VARIABLE 13 +6 +F +4 +99999 +L +CASE 14 +VARIABLE 14 +5 +F +3 +99999 +L +CASE 15 +VARIABLE 15 +5 +F +3 +99999 +L +CASE 16 +VARIABLE 16 +6 +F +4 +99999 +L +CASE 17 +VARIABLE 17 +5 +F +3 +99999 +L +CASE 18 +VARIABLE 18 +5 +F +3 +99999 +L +CASE 19 +VARIABLE 19 +5 +F +3 +99999 +L +CASE 20 +VARIABLE 20 +5 +F +3 +99999 +L +Case 0 +CASE 1 +CASE 2 +CASE 3 +CASE 4 +CASE 5 +CASE 6 +CASE 7 +CASE 8 +CASE 9 +CASE 10 +CASE 11 +CASE 12 +CASE 13 +CASE 14 +CASE 15 +CASE 16 +CASE 17 +CASE 18 +CASE 19 +CASE 20 +Case 1 +191.00 +189.00 +193.00 +162.00 +189.00 +182.00 +211.00 +167.00 +176.00 +154.00 +169.00 +166.00 +154.00 +247.00 +193.00 +202.00 +176.00 +157.00 +156.00 +138.00 +Case 2 +36.00 +37.00 +38.00 +35.00 +35.00 +36.00 +38.00 +34.00 +31.00 +33.00 +34.00 +33.00 +34.00 +46.00 +36.00 +37.00 +37.00 +32.00 +33.00 +33.00 +Case 3 +50.00 +52.00 +58.00 +62.00 +46.00 +56.00 +56.00 +60.00 +74.00 +56.00 +50.00 +52.00 +64.00 +50.00 +46.00 +62.00 +54.00 +52.00 +54.00 +68.00 +Case 4 +5.00 +2.00 +12.00 +12.00 +13.00 +4.00 +8.00 +6.00 +15.00 +17.00 +17.00 +13.00 +14.00 +1.00 +6.00 +12.00 +4.00 +11.00 +15.00 +2.00 +Case 5 +162.00 +110.00 +101.00 +105.00 +155.00 +101.00 +101.00 +125.00 +200.00 +251.00 +120.00 +210.00 +215.00 +50.00 +70.00 +210.00 +60.00 +230.00 +225.00 +110.00 +Case 6 +60.00 +60.00 +101.00 +37.00 +58.00 +42.00 +38.00 +40.00 +40.00 +250.00 +38.00 +115.00 +105.00 +50.00 +31.00 +120.00 +25.00 +80.00 +73.00 +43.00 diff --git a/applications/lazstats/docs/HelpNDoc/LazStats.hnd b/applications/lazstats/docs/HelpNDoc/LazStats.hnd index 92ae98449e132a42ad9eb816656bd5842a412e0c..e7298fe46d53e04e76922468b3a37fbd3d2cdb48 100644 GIT binary patch delta 16023 zcmdUW2|SeB|Nk?a8H{agMVhgP$k_LN$ucO}vm{H3D6*EJ6e>c?DJ4qMf=HP*Td8iP zBxzNtR7$9;O<8{DAy>;p_kQpH`+fa;UhjF%oO7P@{%q&-oO3iu1+TD4?XR&};)GZP zAyj75j4`pverx?O$NjMTj7f#$^$4ur$s(IzEihQ}`bq((f_^^7_DzAs7};4d+EhI~J|RumX&51sI$^CI=8ra4uL(4r{&% zP6MMTi(_E5EG*Qt>FQ?Yx~di$mg=TD7Mf;e>Q#cX6%bM)DaXk|u`4 z!@vMPDwhq2#&FpvC*!yo3=Bzoq<%8tK?IhICW<$W4qUzDhVM4Aq^qJBA3d3dV*8J%>~3PITtK$F3TrN?j2Uf3eT9-ci?R>R+5O}80ia~ zpea&oHp@ZCL(G6sfKY@`f|v=R450!s3qlow4xt924xs^|384j{4WR>}%c|L|XTH)J zdX9!6BYdftAwGWYM$!h75OF6_hNF~2i%^SuLa@O%VG&HoVRCUzU=@z_fQp~377aU$J3(+Hz2>EH330?A{TOrX zJ-!@{U7P}#+nA%63|5MtEgg%;*&woj+Q&(o5hH_RU?!VQ2{Jg~faQ|H#lnI_AEy){ z29Jd!ppnH2TWCA2215YrCGB)L=`^~Uo~n)>9b`Y}lmgw7b{-fGU@c{5KpJZTNlUR( ztWqgEHy)fW@gN|o+Ua89-9*(+2Vgc@3b8U(?Zk<{Wj&-T6Lu$Xh@$yR ze{?rrmC!}p-dmM`>0DqZR1D8 z&>j;5=2<9)I`GN&FvH-$o_r5ufuEiQZ-TK>+x%oWINl@V_k>+Q#Rn?_GWqqVfbt76 z+^nEN$$cCke}yU^SW-7t7|>Rz^0LH>J?;@^6fu*Ra4;?>PG(C$GdCCJg)c5-7YPeL zDGzc!gZg_U4JO6G#=>-7tWS3ycj!E~_=~-tFcD2rl|G$TR<_6Xx2|3w{VJ@*@90@saV__kwx`9NL&{(6^Sa%&O~XTJ zYRavOY$|54_=S`t3}19zQ{s!Z$lk`2kuRRzCPxk%XTObmz)Wb;{W#Fnf330FH+0FN zTwx@MV{?PcqkU-@zpz^YMMY^eBneI^8U{kZilT0}%GW^krgy|(%W*d*cpvvDr(&lR zF{$JH%7nb=n2wV-_fY4B4iBzAa))|(_wG3yXSACV<6pL}+g2v*$S4j@TaL(x9;?>M zZdfmlOVBD~_CL%IvvG7R>U{Su%67fG{mO+O7k53VJ+W(f`1v)9xsXdKm$V%YJ}uPe zRvUiT#a!7E(_5Pu`TX7+_xn3G)eLs$fg=z1z5y}CKA#UC3HOYCpe5Xsa9?6;k^0tX zfpoqPF^-{!I7?Pn7qnza3Cv5JPBJRqM%klQd7(tO!dqz`(>S1Ynqr=A{jh}M41Wdg z=7oLdL(58fVn zYrSRmu+izLXZnxYK74BBU1p;CVKpu~ys(;9@%hUA%0xG>47Y|SjsC7dJ-46iRSaEx zwEM|$rjq_HDfz`BOc!J0kS^o5po`~F!3^2C+tO04ax7kby3=Rr*jA&S*nOeXnwqF{ zec0paEatW)z92XE*6rKo>BIe9A2+p1?9O#qVYIunF|Cj+q}#o|_(g%WLS#_7Oayha zi?c_>P^|Mw>js;Jn(;c4am5c#clqk$T=u+5rYP7kIM>Le%PwS|yP_Uh_F!5ObI0N7 zO!%(eg-)H0=Hd(Ta$DXJqlex<3V-zWMyq&De(hjxarKJ2FLAEX*K%etYLhPSRp{7q z@%FQ~iVpg|3-0EADKk2vljr{|Fmlr=5&f8QvR3vPuahb^FUgbR<(4cQ)IaG!8>ircIuR(}7= zqN{wx$#s2QkL$SSNVRHpAw>t=IPZ7FNjeGBUnXbCRQPxFwelUQG5Bmw;_H^BI8b12$?m;{CNUBfelgzt>15BcDxb(Bw>SCcU zyti;QxpKX{o_ab$i$Y($-0PzgV0_$nW&^R|>J`Oz@u8;;GS=USo$tNhFvFo0Df~0E zY;Qwel&4RwJV(Ba*wH_ZJ++S8V9SkNihD4-*vw7$TCNs#Mf+2ew!~FwS{*(JLVkD1H)s>9`Cz6bg|qUYP=f0orqO)GZp-N7 zzAKNNd4u@cV=wY={rD$Nxajaf>!@A*Hhb%1%F|=`UF&URsZ%^v@@x6DLSzXwYc7Udplf9;@O;=YU|Mc_A?^0__jx%wqkjMs)8iS9a65?r%SxmTuV6g%B?NUbb*G@ZoE z+5R?9@1bkiqR9JCZb}Y3u3te);kz|Og()%LXrQ0a)>FFWgQDh*86WdL1_>WZ-7wYZ zdh5-qnoDkr+;yejZLbmM;{-NoX zUQEYD7~xBbyLYeQdX(%Elqb45jWwWinm+H7+cCE}EobvBeDfF|u1kg(JdD14GJO?B z)p$kP?2aFU~}l+zkk&9ax#twxoh9vUUL84O=mZwnFGw7wceloGW{#P``aJQI^no4D4GwDSAn3>*iA|E;rsRG^YmI+ZP$0(vt2ytSoYXO zFJ->^;MLvAE1-V9HDW_c`x9nSI*FJRyKv6AOOKt}dXnfp(WkvtKpJAV(8Xq+oBrY@ zntf}Or?$2xT7D{(2-hUK2YUUv!HvP^#PY)=R%}_ulP6AFlga#V}cGY|}`r ze6bUCZNkE~<~rxnwjA)?dc=O8y@(7$@pW!@t8Ey8db?-6KWl@yCreByvM}@2g+uil z@X8T;uX1lZ;l4ck*x`mXrfFmzvCLQNR`V#+H8dApXqEF-pO%v}rEDF?S`on_$=Ha? zpSI3kx3fk~_mFrjVSB)-(+3@1n=`%eifsl8q||e!XPaBiF7r4QF6uLrD%%p}elx=V zdR>tE@%lwiK9DlPwE9&V9NcGQ4~ojnbm0=a=V`f}i{Z_hoxbNdcTn1mEP{dv^IcCx)BEgPOXWR-X;q#+9>f_VSY_rY1YozM4s(z|(Y z3fEgEP>zd`Te`TqG9>~+vD zy;%1o9_-`%&=3>l7-Q`__q?x>iCM*Nd_!8R?6S}AULHNF#^gFyRn>E!)%)c920=l= zcQy;=5{jJ5dg9Xe=qu5-Zp*@y*YLvex2OZM&2ewXr3>T$^dCen;VWpy_+kqBp}M zwtd^E-n4Sy?M0#3x93G$h4Q>lM>oH?TN#|6_&G$=ay4IK$WA)GC&j-00kV_I_1ZVbtZo$}-!^wG8 zTjb_vF0EJ_Sl0jibJ&6OU{mK$`*&Zq+04wcHd(NyBDa3{QAsk(IB@y$qct@(wY9Y+ zC9m%W=NCy@29fUC9W&~9_N@D1_0C&7bA<3&B@c&aoTkCS^2{)@o}QkSmDM6+#usAl zj-vONKTIee1#RM3l#GC_DXkwV$dn`*B#S-p5!T2&8s`aVn9?mudPv8DyL5(t;2r0< zIcE;>2hz{_sk`ScZ>Yvt*R}V`zKIc<#?erOYa)(wvrN7!~$^(HZe!VG&a<9J# z3Mx79=KVST)(vlwm7+4!T|r7uCQV4gKOhF5t@;U1dLf0>a8m>h+nL2!^K*&OO?yb> zKf-s4t;9~*OL^m+mB#!!XiAiI0c8MNrDxh@gdsPdG%**e;TD;G*lx94V5>xO+Li4m zpd>9Nh4l?R1#hj+x#oBCG<%p`Jp5`+@9MP;uX0FH*0dar#s>nb?=nJ43l0C^7p>yy zUVPFKF^^KIi>cq6B+7W4>9?)@LD!dbk2d8K(rLo8pCmG+6nb6vW|!oYfA+y5xUu&l zySvR7=R8vKT70b!E~}&c_7Y^H2?d$`Bg$tjSd!mw)_|0&ssOtI6?#;_>Djotvu!o2 z#En}qwB-C(h${B$h8APP9NpQXyW24cJT5+U>z1p4t(8{z!}-+4z3C#(CgtqWj}kd)Gt-B90}nOtlkD}q&?%UsO5lq^{P5qr z%>A2Xn$PHmFY!K-7O~nn>TH0lT=fbsW*`2e+j-Gl?YnK>?cCtvf319H&2iQt-w6A- zBOVxO5y;=YLn*6a+RM`WkpbSTn5)v$l=@v<;_uvOJ7TzbO3s@jWv8FTr8KR* zDy1zDeE#9b+ypyY``)OeO9jVm7xT)#vOKnbN0oMjsnfZ4mokmap51g#eO>oSV1ICw z{VC>*1F{<)9y`AUU%NK(orqTN!+Y~@oV|T3zUZ1xPr{~~3KwS_4m`3vz!AIN>{64j zyjikS;hkxh7Tvwi@}jnQM!vFJG{5(;DVOu1TjI^fSSgM*{RszK?#N85!97ilYwFy- zVoqeV+;&GA#0GhT-! zZVI+sxbp%Nqg8uwe{}&X^RCI6IsPW)TRN9aZ}Z93J>K6Owb8P(E>>V~aFkh$z{|aX z;YMECPn(ZfxXaqU+VNo8V!^GoW#H=6xW*p)EKa9&LG&Q5zRQ9MTe?fOmCTXK_Bhvk z+u%gCe<(dyxZ6M@>0S4VPrMtc&kYL~-m=`ASMuJaF>xc)yoEAg zz=JX$oG4384IfC9p6v9_P<7?#IVnpQZ_mMM_tB8TY^FIiV+kdo=cD5EU!I*kBLR3K zDNR668&-mz&x$mbSh8y|2J}{Vyr)feFv)s+)Pu^itxkb}Q3UnXRAG1%c&Q{YdJ`2_ zL}*{H@zQ9`NI%i>r_hH*e(D4tR-gfaUJH@0J*kSwgcr*GcWDKFq6PIET*M(G#??uB z^d|o=sZx<+h^q1r2A2Po-eVRXv+F;TT{11CCpSv2JbD`wWz0bJ8x7?E+KUc@;qP6j zN@K%)%ZDn4#_@>9zIqSUevGo>F!YI&y#&VyFZv;6`ZuY67IehE-${Wg^}W}jSYtBG zN&Tw!s0=VTD2)GDhHs@BjolF$#y`HsAT)*oQGupSqtmp&^{Wbs=->5A(YcuHBFr40 z$N!U(3Cu;mPdsk3v0#K5#+@Phzt#e-Zhu<~RPu3+zfPu+j69~38vHg^&qm{KTF3hR zul1kum%L*VeU*PC|9>Ohm|A1q#trfRuw=@{V(jQpp~maSMTPImw_O$@6RPohei|SB zACwIK6E!At#IJN8x5B?r`WGBQ-)lILBmR9g*f{q8D@U-k$iLtS)8_{NO-Ha*<6B3t z@zY=Ph3&)t?HR#Vh;c`-ZJt;I*a}lqwt(}0;)sdt#x6;*m2=z?Y?~)m<3Dr6#Du@C z!N1{%j(;#C#?6nGP-Vui@$c+PY!&~{9YG!E8kOYx@82E+Ot$P|E8#c#v47jL(|=qN z1=?7<4nhNQwi4WI1pdyb-<(^BhL0=5uJo@9JQCV)oAC3|$v2CM|B58g?Bk}>g{FJ` z#DJTvWdDMVzO(-iVLh(xSEv5kM(X2z*_GIOYs}OWoi}Blo;!Bl1T6rM9>&hIenI%X zI%Dzom-wT{VkjY-vjX(|LjWO^At6WyTH%U;m~^wYzz2G5sn0X zZ3#glVQCTU8Hz-F?X?v43y1yDXVEbukw9SbSx(%-f27-J(?Zy^e1vEr>=uf|LD@z& zkTe~dDovG#%M@`%ERng0DPj%pG{hdUK^zb}@G#O-UQkP$ras;grHcT~e>w~Dn8Tq~ zKt{6>6`Ok<1nJI*3VhrJa-;mqVdDZM7P2YOtl_tC*c}y|hR_i>;h~a|;MxvOQODpP z8g)m8aTx6~@&FA%_fa;;yb(F|zShy<-5CxO1`!IWmcx4#5(kD5T}b{t zHA?2_ZP4`Q!vouZd;y*_>ePoLMLTmbOQ^VKUB-Heuw5B5y7#t1$-!V8HQJs`p^(X4l z#PkcTX;7}8snL-7-q-Yzob+phC-DCRgR=`WbRzvoJz*v*&vW=WolK~+8Z_h2I-{}t zBk_cJti6|k7iTxCC(PbzY^c$I`jL9VOg2KzZfc<;{le2|@c*neJ5NuP%c#1DI=p^N z-;=zue$Jw!q5PxL6Qwf9j0WM~Vn%1(k2=$#_&=L_!c5lQXoeSOH?b!4^v_EKI>OG= z6J;{0Hq6C;)7+?Oe^eR``Ja`ZFp=@8m~n8T>mmoZDpCQ{qdY}LM^`oIU0@KrLC29tk7w`(;iDTwz5*-UYBe94;k;VL2SGyB5QGxXuF@dtE_b#`M@lbb&7$ z7!063j$as@BJ**9doH?MK+INx3mjU>&jsQ+`M9`IOO3A0=wOe9uAlm{|?nF3u!av2Je~v--2%|vDM~+KMCU7bxH(IRbATri$=a}>dK46bD*_5?u z!Hi5Si+=%UFb@4yX9dJjR&udJ0*PfpBqS5jUkO&S>hEwH6Ip)3wt$4G0j52o=ua^T zM_BbU80vUXcT-*f&J?K6<^o= z-^Ze%mw_m#$&ls%*A^2wm_G+|92|274BzGO9)KoUc>NggaN7b~;dTmsqPwQiZA}0y z1;83~H-)yM&!ck(ErpGg&|N|7$fTV&vU{QdR-46CaQL-3nfu!bQ{!qc3aU3-a{-6b zW*ngNo`sko8!13@uY@p=(6Z$P1tlarFgrq|fHS2eF2MJvEe(`63X=JJp@88dLPVkB zfjvWfQw7nq5d$R%fs&(}#~8SE6rj$PAAMMEs<4)@Kir$4n>g46cS;c>N(BQk6#;Q> zbikMq-Dd#FJOyEJ#n*tJ#}Rf4gqk~}WS}{YDhLdwNs@%o9Tl1w6h`!>!3hWVjUYRd zQy7qsEAWG5$&w--#Ehq*X_MK3o6Jn(j$0(ynb$QT9S^-_ci2GXQOz`@t% zA{aH0yh(a0=(uMwoyx|@-?(cjpi_wwpgWSE9~5}F@dMYX?$ae`2r8&45)H*dRSkxB zbmNMK!4gmx;VBB1rh9S#kqwr!KmoTY85lBYyr7EPlpm8T delta 1292 zcmYM!Z){Ul6aeu1=l$#JYu^R~gbn&yx51duZcsYx${vgj)<g)w@N*{5xQT_?wvCMg_0u&lq4`krc6I8Skh3IeHOPn|FwfHeXD8t@e3R z6;Ci&J7!qo+Hzj=t4xA~1VIl;RqC;|T=5M%V#YG*1{LM?(ml8Mu~xcGbGDST<(#eL zY&BkCtuj_n1e;d?7bqA9^5gQBDcUkZ4 zO(ihreuV-ruIF`ftCYZ!x8tVr!@bpLE}DmG(0o*j9zzSzLKH+HREO%(BD5HV(GnCv z4QQzt?tQ#@Pn$N2_{bnJ^VH`(>fWHfr-qdelot6*Jd_d6rLFvTzK8AiR(ei(mKYzB zL1VT13M-{==|AW%xPEhWY7e!2OT*1AFmc@ftlFg}60SroG~J5%Vd3X9Ehtd7K>S@A zolrD$3fYQD1|<(_?8!s`qSscvCSI8tou*)w$g9w8vhCV`ll(t!fq3AHY6Tu4--CK4 z8Ug!EG>JE|jbnY_YQzcT+1V&+6zpt_1$m#>Itm=UKM zE=QcIe0ns7mZ2tOqvdD?YDOzj3u;BH&}xw$ZF{$ie@kK@XX0}iy8sI_@g){-;}_+1 z+PK%!%amQ@K5aG+DSfU|`ZYaAyV*9eFB7k0tdhg*JFbAdOJd}u;(^Lt#b4hYmsO0$ zi&5GI6VJ!ziyfQe(}yXC{eGtbWWQ4jxBO0uO0X*6G!_Hmbihe^c!PQw)R40jR)lcm z$HwgG;y}nLSK;KSQ=P}1qBSUi)}nQ&9X)}bMC;L0s6$+iB*Uvq6b~V0)+FAnmw2)s z0_E?gZ;1QZWZn(gaVMMWPUgBdP|^qp=K*FTk#2LG-vIN?4B{%jgevxYlLFk zQqLliAd`=VO&J_GmTCgi?^u&P(FZ-IXO3t-;U7?n%_FdRECqsfUR7)xaY`7Bolf7C gCuiFOz6Qq Product-Moment with option Save Matrix to Grid +// before executing the Average Link Clustering command in order to +// have a symmetrical matrix. + unit AvgLinkUnit; {$mode objfpc}{$H+} @@ -15,21 +21,19 @@ type TAvgLinkFrm = class(TForm) Bevel1: TBevel; - CancelBtn: TButton; ComputeBtn: TButton; HelpBtn: TButton; - ReturnBtn: TButton; - RadioGroup1: TRadioGroup; + CloseBtn: TButton; + MatrixTypeGroup: TRadioGroup; procedure ComputeBtnClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure HelpBtnClick(Sender: TObject); - procedure TreePlot(Clusters : IntDyneMat; Lst : IntDyneVec; NoPoints : integer); - procedure PreTree(NN, CRIT : integer; LST : IntDyneVec; KLUS : IntDyneMat); - private { private declarations } + procedure PreTree(NN, CRIT: integer; LST: IntDyneVec; KLUS: IntDyneMat; AReport: TStrings); + procedure TreePlot(Clusters: IntDyneMat; Lst: IntDyneVec; NoPoints: integer; AReport: TStrings); public { public declarations } end; @@ -48,23 +52,20 @@ procedure TAvgLinkFrm.FormActivate(Sender: TObject); var w: Integer; begin - w := MaxValue([HelpBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); + w := MaxValue([HelpBtn.Width, ComputeBtn.Width, CloseBtn.Width]); HelpBtn.Constraints.MinWidth := w; - CancelBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w; - ReturnBtn.Constraints.MinWidth := w; + CloseBtn.Constraints.MinWidth := w; end; procedure TAvgLinkFrm.FormCreate(Sender: TObject); begin Assert(OS3MainFrm <> nil); - if OutputFrm = nil then - Application.CreateForm(TOutputFrm, OutputFrm); end; procedure TAvgLinkFrm.FormShow(Sender: TObject); begin - RadioGroup1.ItemIndex := 0; + MatrixTypeGroup.ItemIndex := 0; end; procedure TAvgLinkFrm.HelpBtnClick(Sender: TObject); @@ -75,73 +76,76 @@ begin end; procedure TAvgLinkFrm.ComputeBtnClick(Sender: TObject); +const + SIM_DIS: array[0..1] of String = ('Similarity', 'Dissimilarity'); VAR - X : DblDyneMat; // similarity or dissimilarity matrix - KLUS : IntDyneMat; - LST : IntDyneVec; - RX, SAV, SAV2, RRRMIN : double; - NIN, NVAR : IntDyneVec; - I, J, K, L, M, MN, N, CRIT, ITR, LIMIT : integer; -// ROWS : StrDyneVec; - DIS, Title : string; - outline : string; - nvalues : integer; -label label300, label60, label70; + X : DblDyneMat; // similarity or dissimilarity matrix + KLUS : IntDyneMat; + LST : IntDyneVec; + RX, SAV, SAV2, RRRMIN : double; + NIN, NVAR : IntDyneVec; + I, J, K, L, M, MN, N, CRIT, ITR, LIMIT : integer; + // ROWS : StrDyneVec; + nvalues : integer; + lReport: TStrings; + +label + label300, label60, label70; begin - // Reference: Anderberg, M. R. (1973). Cluster analysis for - // applications. New York: Academic press. - // - // Almost any text on cluster analysis should have a good - // description of the average-linkage hierarchical clustering - // algorithm. The algorithm begins with an initial similarity - // or dissimilarity matrix between pairs of objects. The - // algorithm proceeds in an iterative way. At each iteration - // the two most similar (we assume similarities for explanation) - // objects are combined into one group. At each successive - // iteration, the two most similar objects or groups of objects are - // merged. Similarity between groups is defined as the average - // similarity between objects in one group with objects in the other. - // - // INPUT: A correlation matrix (or some other similarity or - // dissimilarity matrix) in a file named MATRIX.DAT - // This must contain all the elements of a full - // (n x n), symmetrical matrix. Any format is - // allowable, as long as numbers are separated by - // blanks. - // - // OUTPUT: Output consists of a cluster history and a tree - // diagram (dendogram). The cluster history - // indicates, for each iteration, the objects - // or clusters merged, and the average pairwise - // similarity or dissimilarity in the resulting - // cluster. - // - // Author: John Uebersax + // Reference: Anderberg, M. R. (1973). Cluster analysis for + // applications. New York: Academic press. + // + // Almost any text on cluster analysis should have a good + // description of the average-linkage hierarchical clustering + // algorithm. The algorithm begins with an initial similarity + // or dissimilarity matrix between pairs of objects. The + // algorithm proceeds in an iterative way. At each iteration + // the two most similar (we assume similarities for explanation) + // objects are combined into one group. At each successive + // iteration, the two most similar objects or groups of objects are + // merged. Similarity between groups is defined as the average + // similarity between objects in one group with objects in the other. + // + // INPUT: A correlation matrix (or some other similarity or + // dissimilarity matrix) in a file named MATRIX.DAT + // This must contain all the elements of a full + // (n x n), symmetrical matrix. Any format is + // allowable, as long as numbers are separated by + // blanks. + // + // OUTPUT: Output consists of a cluster history and a tree + // diagram (dendogram). The cluster history + // indicates, for each iteration, the objects + // or clusters merged, and the average pairwise + // similarity or dissimilarity in the resulting + // cluster. + // + // Author: John Uebersax - nvalues := NoVariables; - if (NoVariables <= 0) then - begin - ShowMessage('ERROR! You must first load a matrix into the grid.'); - exit; - end; + if (NoVariables <= 0) then + begin + MessageDlg('You must first load a matrix into the grid.', mtError, [mbOK], 0); + exit; + end; - SetLength(X,nvalues+1,nvalues+1); - SetLength(KLUS,nvalues+1,3); - SetLength(LST,nvalues+1); - SetLength(NIN,nvalues+1); - SetLength(NVAR,nvalues+1); + nvalues := NoVariables; + SetLength(X,nvalues+1,nvalues+1); + SetLength(KLUS,nvalues+1,3); + SetLength(LST,nvalues+1); + SetLength(NIN,nvalues+1); + SetLength(NVAR,nvalues+1); - Title := 'Average Linkage Cluster Analysis. Adopted from ClusBas by John S. Uebersax'; + lReport := TStringList.Create; + try + lReport.Add('AVERAGE LINK CLUSTER ANALYSIS'); + lReport.Add('Adopted from ClusBas by John S. Uebersax'); + lReport.Add(''); // This section does the cluster analysis, taking data from the Main Form. // Parameters controlling the analysis are obtained from the dialog form. - DIS := 'DIS'; - OutputFrm.RichEdit.Clear; - OutputFrm.RichEdit.Lines.Add(Title); - OutputFrm.RichEdit.Lines.Add(''); M := nvalues; - CRIT := RadioGroup1.ItemIndex; // 0 := Similarity, 1 := dissimilarity + CRIT := MatrixTypeGroup.ItemIndex; // 0 := Similarity, 1 := dissimilarity // get matrix of data from OS3MainFrm for i := 1 to NoVariables do @@ -255,17 +259,14 @@ label70: // end of ARRANGE procedure // continuation of CLUSV1 procedure // OUTPUT + lReport.Add('Group %3d is joined by group %3d. N is %3d ITER: %3d %s: %10.3f', [NVAR[K], NVAR[L], NIN[K], ITR, SIM_DIS[CRIT], RX]); + { if (CRIT = 0) then - begin - outline := format('Group %3d is joined by group %3d. N is %3d ITER := %3d SIM := %10.3f', - [NVAR[K], NVAR[L],NIN[K],ITR,RX]); - OutputFrm.RichEdit.Lines.Add(outline); - end else - begin - outline := format('Group %3d is joined by group %3d. N is %3d ITER := %3d DIS := %10.3f', - [NVAR[K], NVAR[L],NIN[K],ITR,RX]); - OutputFrm.RichEdit.Lines.Add(outline); - end; + lReport.Add('Group %3d is joined by group %3d. N is %3d ITER: %3d SIM: %10.3f', [NVAR[K], NVAR[L], NIN[K], ITR, RX]) + else + lReport.Add('Group %3d is joined by group %3d. N is %3d ITER: %3d DIS: %10.3f', [NVAR[K], NVAR[L], NIN[K], ITR, RX]); + } + KLUS[ITR,1] := NVAR[K]; // save in KLUS rather than write out to file as in KLUS[ITR,2] := NVAR[L]; // original program if not(L = M) then @@ -275,26 +276,32 @@ label70: // end of ARRANGE procedure end; M := M - 1; if (ITR < LIMIT) then goto label300; - OutputFrm.RichEdit.Lines.Add(''); -// OutputFrm.ShowModal; + lReport.Add(''); // End of CLUSV1 procedure // do pre-tree processing - PreTree(nvalues, CRIT, LST, KLUS); - OutputFrm.ShowModal; - // do TREE procedure - TreePlot(KLUS,LST,nvalues); - OutputFrm.ShowModal; + PreTree(nvalues, CRIT, LST, KLUS, lReport); + lReport.Add(''); + lReport.Add(DIVIDER); + lReport.Add(''); - // cleanup + // do TREE procedure + TreePlot(KLUS, LST, nvalues, lReport); + + DisplayReport(lReport); + + finally + lReport.Free; NVAR := nil; NIN := nil; LST := nil; KLUS := nil; X := nil; + end; end; -procedure TAvgLinkFrm.TreePlot(Clusters : IntDyneMat; Lst : IntDyneVec; NoPoints : integer); +procedure TAvgLinkFrm.TreePlot(Clusters: IntDyneMat; Lst: IntDyneVec; + NoPoints: integer; AReport: TStrings); VAR outline : array[0..501] of char; aline : array[0..82] of char; @@ -308,15 +315,14 @@ VAR Results : StrDyneVec; ColPos : IntDyneVec; i, j, k, L, linecount, newcol, howlong, count: integer; - done : boolean; begin linecount := 1; star := '*'; blank := ' '; SetLength(ColPos,NoPoints+2); SetLength(Results,NoPoints*2+3); - OutputFrm.RichEdit.Lines.Add(''); - done := false; + //AReport.Add(''); + // store initial column positions of vertical linkages for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5); @@ -340,7 +346,7 @@ begin for i := 1 to NoPoints - 1 do begin outline := ''; - valstr := format('%5d',[i]); // put step no. first + valstr := Format('%5d',[i]); // put step no. first outline := valstr; // clear remainder of outline for j := 5 to (5 + NoPoints * 5) do outline[j] := ' '; @@ -384,21 +390,17 @@ begin if (noparts <= 0) then noparts := 1; if (noparts = 1) then // simply print the list - begin for i := 0 to linecount - 1 do - begin - OutputFrm.RichEdit.Lines.Add(Results[i]); - end; - end + AReport.Add(Results[i]) else // break lines into strings of 15 units begin startcol := 0; endcol := 80; for i := 1 to noparts do begin - outline := format('PART %d OUTPUT',[i]); - OutputFrm.RichEdit.Lines.Add(outline); - for j := 0 to 80 do aline[j] := blank; + AReport.Add('PART %d OUTPUT', [i]); + for j := 0 to 80 do + aline[j] := blank; for j := 0 to linecount - 1 do begin @@ -410,9 +412,9 @@ begin count := count + 1; end; aline[count+1] := #0; - OutputFrm.RichEdit.Lines.Add(aline); + AReport.Add(aline); end; - OutputFrm.RichEdit.Lines.Add(''); + AReport.Add(''); startcol := endcol + 1; endcol := endcol + 80; if (endcol > howlong) then endcol := howlong; @@ -422,25 +424,26 @@ begin ColPos := nil; end; -procedure TAvgLinkFrm.PreTree(NN, CRIT : integer; LST : IntDyneVec; KLUS : IntDyneMat); +procedure TAvgLinkFrm.PreTree(NN, CRIT: integer; LST: IntDyneVec; + KLUS: IntDyneMat; AReport: TStrings); VAR - I, II, J, NI, NJ, L, M, N, Ina, INEND, NHOLD, NLINES, INDX, ICOL, JCOL : integer; - KSH, JEND, MSH : integer; - JHOLD, NIN1 : IntDyneVec; - outline, outvalue : string; -label label2015, label2020, label2030, label2040, label2055, label2060; - + I, II, J, NI, NJ, L, M, N, Ina, INEND, NHOLD, NLINES, INDX, ICOL, JCOL: integer; + KSH, JEND, MSH: integer; + JHOLD, NIN1: IntDyneVec; + outline: string; +label + label2015, label2020, label2030, label2040, label2055, label2060; begin // PRETRE procedure SetLength(JHOLD,NN+1); SetLength(NIN1,NN+1); // int NN := nvalues; N := NN - 1; - outline := format('No. of objects := %3d',[NN]); - OutputFrm.RichEdit.Lines.Add(outline); - if (CRIT = 0) then outline := 'Matrix defined similarities among objects.' - else outline := 'Matrix defined dissimilarities among objects.'; - OutputFrm.RichEdit.Lines.Add(outline); + AReport.Add('No. of objects: %3d', [NN]); + if (CRIT = 0) then + AReport.Add('Matrix defined similarities among objects.') + else + AReport.Add('Matrix defined dissimilarities among objects.'); for I := 1 to NN do begin @@ -509,13 +512,12 @@ label2060: for J := 1 to 20 do begin INDX := INDX + 1; - if (INDX <= NN) then - begin - outvalue := format(' %3d',[LST[INDX]]); - outline := outline + outvalue; - end; + if (INDX <= NN) then // wp: This outline is not printed anywhere !!! + outline := outline + Format(' %3d', [LST[INDX]]); end; end; + AReport.Add(outline); // wp: added, without it outline would not be used anywhere + NIN1 := nil; JHOLD := nil; // End of PRETRE procedure