Jednodimenzionalni tezinski k - means LS-kvazimetricka funkcija

UPUTE : 
 Pod   su podaci oblika {Table[{w[[i]], A[[i]] }, {i, m}], Table[z[[j]], {j, k}]}
z   je vektor pocetnih centara
Ako je Ind≠ 0, ispisuju se i crtaju  medjukoraci

Moduli

WKMeans1[Pod_,z_,Ind_]:=Module[{PI,tab,min,imin,z0,c,k=Length[z],m=Length[Pod],podaci,centri},
podaci=Table[{Pod[[i]][[2]],.5},{i,m}];
z0=z;
If[Ind≠0,Print["A = ",Pod[[All,2]],"\nw = ",Pod[[All,1]],"\nAssignment points = ",z0,"\nF =",Sum[Pod[[i,1]]Min[Table[Abs[Pod[[i,2]]-z0[[j]] ]^2,{j,k}]],{i,m}]]; 
centri=Table[{z0[[i]],.5},{i,k}]; Print[ListPlot[{podaci,centri},PlotMarkers->Automatic,Axes->{True,False},PlotRange->{0,1},AspectRatio->Automatic]]];
PI=Table[{},{i,k}]; 
Do[
tab=Table[Norm[Pod[[i]][[2]]-z0[[j]]],{j,k}];
min=Min[tab];
imin=Position[tab,min][[1]] ;
PI[[imin[[1]]]]=Append[PI[[imin[[1]]]],Pod[[i]]],
{i,m}];
c=Table[0,{j,k}];
While[
Do[j1=k-j+1;mj=Length[PI[[j1]]];
If[mj≠0,
c[[j1]]=Sum[PI[[j1,All,1]][[s]]*PI[[j1,All,2]][[s]],{s,mj}]/Sum[PI[[j1,All,1]][[s]],{s,mj}],
PI=Drop[PI,{j1}];c=Drop[c,{j1}];z0=Drop[z0,{j1}]
    ],{j,k}];
k=Length[PI];
Chop[Norm[c-z0]]≠0,
centri=Table[{c[[i]],.5},{i,k}];
If[Ind≠ 0,
Print["Particija: ",PI,"\nCentri: ",c,"\nF: ",WFLS[PI,c]];
Print["\nF=",Sum[Pod[[i,1]]Min[Table[Abs[Pod[[i,2]]-c[[j]] ]^2,{j,k}]],{i,m}]];
Print[ListPlot[{podaci,centri},PlotMarkers->Automatic,Axes->{True,False},PlotRange->{0,1},AspectRatio->Automatic]];
    ];
z0=c;
PI=Table[{},{i,k}]; 
Do[
tab=Table[Norm[Pod[[i]][[2]]-z0[[j]]],{j,k}];
min=Min[tab];
imin=Position[tab,min][[1]] ;
PI[[imin[[1]]]]=Append[PI[[imin[[1]]]],Pod[[i]]],
{i,m}];
               ];
{PI,z0,WFLS[PI,z0]}]

                                                                 (* LS funkcija cilja *)
WFLS[PI_,c_]:=Module[{},
Return[Sum[PI[[j,s,1]]*Norm[PI[[j,s,2]]-c[[j]]]^2,{j,Length[PI]},{s,Length[PI[[j]]]}]]
];

Indeksi

(* Dunn Index *)
Clear[VD]
VD[PI_,z_]:=Module[{k=Length[z],FF=VV=Table[0,{j,k}],mj,d,R,r},
DD=Table[If[i≠j,Min[Table[Norm[PI[[i,p,2]]-PI[[j,q,2]]]^2,{p,Length[PI[[i]]]},{q,Length[PI[[j]]]}]],Infinity],{i,k},{j,k}];
diam=Table[Max[Table[Norm[PI[[i,p,2]]-PI[[i,q,2]]]^2,{p,Length[PI[[i]]]},{q,Length[PI[[i]]]}]],{i,k}];
Min[DD]/Max[diam]
]

                                                        (* Davies - Bouldin *)
Clear[VDB]
VDB[PI_,z_]:=Module[{k=Length[z],FF=VV=Table[0,{j,k}],mj,d,R,r},
Do[
mj=Length[PI[[j]]];(* ove kvadrate treba jos provjeriti *)
FF[[j]]=Sum[PI[[j,i,1]]*Abs[PI[[j,i,2]]-z[[j]] ]^2,{i,mj}];
VV[[j]]=FF[[j]]/Sum[PI[[j,i,1]],{i,mj}]
   ,{j,k}];
d=Table[Abs[z[[i]]-z[[j]]]^2,{i,k},{j,k}];
R=Table[0,{i,k},{j,k}];
Do[
Do[
If[i≠j,R[[i,j]]=(VV[[i]]+VV[[j]])/d[[i,j]]   ]
,{i,k}]
         ,{j,k}];
r=Table[Max[Table[R[[i,j]],{j,k}] ],{i,k}];
Total[r]/k
            ]

                                               (* Calinski - Harabasz index *)
Clear[VCH]
VCH[PI_,z_]:=Module[{k=Length[z],m=Sum[Length[PI[[j]]],{j,k}],FF=Table[0,{j,k}],mj,F,G},
Do[
mj=Length[PI[[j]]];
FF[[j]]=Sum[PI[[j,s,1]]*Abs[PI[[j,s,2]]-z[[j]] ]^2,{s,mj}];
   ,{j,k}];
F=Total[FF];
cc=Sum[Sum[PI[[j,s,1]]*PI[[j,s,2]],{s,Length[PI[[j]]]}],{j,k}]/Sum[Sum[PI[[j,s,1]],{s,Length[PI[[j]]]}],{j,k}];
G=Sum[Sum[PI[[j,s,1]],{s,Length[PI[[j]]]}]*Abs[z[[j]]-cc]^2,{j,k}];
(m-k)*G/((k-1)F)
                                     ]

(* Simplified Silhouette Index *)
Clear[SVC]
SVC[w_,A_,z_]:=Module[{m=Length[A],k=Length[z],a=b=Table[0,{i,m}],dd},
Do[
dd=Sort[Table[w[[i]] Norm[A[[i]]-z[[j]]]^2,{j,k}]];
a[[i]]=dd[[1]];b[[i]]=dd[[2]];
,{i,m}];
Sum[(b[[i]]-a[[i]])/Max[{a[[i]],b[[i]]}],{i,m}]/m
]

Podaci 1

A={1,2,6,7,9}//N; m=Length[A]; 
w=Table[1,{i,m}]; 
z={4,8}; k=Length[z]; 
A={1,2,3,8,9,10,25}; m=Length[A];
w={1,1,.1,.5,.5,1,.2}
z={2,8,10};k=Length[z];

Pod=Table[{w[[i]],A[[i]]},{i,m}];

                                                     (* Poziv modula *)
sol=WKMeans1[Pod,z,1];                    
                                                     (* Rezultati *)
PI=sol[[1]]; z=sol[[2]]; F=sol[[3]];
Print["Particija: ",PI]
Print["Centri: ",z]
FF=VV=Table[{},{j,k}];
Do[
FF[[j]]=Sum[PI[[j,i,1]]*Norm[PI[[j,i,2]]-z[[j]] ]^2,{i,Length[PI[[j]]]}];
VV[[j]]=FF[[j]]/Sum[PI[[j,i,1]],{i,Length[PI[[j]]]}]
,{j,k}]
Print["F: ",F," = ",FF]
Print["Prosj. kvadratno rasipanje: ",VV]
Print["Prosj. rasipanje: ",Sqrt[VV]]
       (* INDEKSI *)
(* Dunn *)
Print["Dunn Index (za k=",k,") = ",VD[PI,z]]
(* Davies - Bouldin *)
Print["Davies - Bouldin Index (za k=",k,") = ",VDB[PI,z]]
(* Calinski - Harabasz index  *)
Print["Calinski - Harabasz index (za k=",k,") = ",VCH[PI,z]]
(* Simplified Silhouette Index  *)
Print["Simplified Silhouette Index (za k=",k,") = ",SVC[w,Pod,z]]

Podaci 2 (slucajni brojevi iz intervala [1,20] s tezinama)

m=15;
k=2;
SeedRandom[13]
A=RandomReal[{1,20},m];
w=RandomInteger[{1,5},m];
z={13,15};
Pod=Table[{w[[i]],A[[i]]},{i,m}];

                                                  (* Poziv modula *)
sol=WKMeans1[Pod,z,0]                    
                                                     (* Rezultati *)
PI=sol[[1]]; z=sol[[2]]; F=sol[[3]];
Print["Particija: ",PI]
Print["Centri: ",z]
FF=VV=Table[{},{j,k}];
Do[
FF[[j]]=Sum[PI[[j,i,1]]*Norm[PI[[j,i,2]]-z[[j]] ]^2,{i,Length[PI[[j]]]}];
VV[[j]]=FF[[j]]/Sum[PI[[j,i,1]],{i,Length[PI[[j]]]}]
,{j,k}]
Print["F: ",F," = ",FF]
Print["Prosj. kvadratno rasipanje: ",VV]
Print["Prosj. rasipanje: ",Sqrt[VV]]
   (* INDEKSI *)
(* Dunn *)
Print["Dunn Index (za k=",k,") = ",VD[PI,z]]
(* Davies - Bouldin *)
Print["Davies - Bouldin Index (za k=",k,") = ",VDB[PI,z]]
(* Calinski - Harabasz index  *)
Print["Calinski - Harabasz index (za k=",k,") = ",VCH[PI,z]]
(* Simplified Silhouette Index  *)
Print["Simplified Silhouette Index (za k=",k,") = ",SVC[w,Pod,z]]