Курсовой проект групп 3341 и 3382 / MyEM / m_EM

unit m_EM;

interface
uses Classes,Sysutils,Types,Math,Graphics,typeEM;

type
TEM = class
private
data: TEMList2;

M: integer;
N: integer;
d: integer;

P: TEMList1;
u: TEMList2;
V: TEMList1;
P_old: TEMList1;
u_old: TEMList2;
V_old: TEMList1;

P_x_a: TEMList1;
P_x_a_old: TEMList1;

err: string;
strf: string;
Min: TEMList1;
Max: TEMList1;
Cntiter: integer;
public
constructor create(ldata:TEMList2; MM:integer;CI:integer);overload;
constructor create();overload;
destructor destroy;override;

procedure learn;
procedure test(ldata: TEMList2);
procedure setnumofcl(MM: integer);
procedure setnumofit(CI: integer);
procedure setdata(ldata: TEMList2);
procedure setstrf(s: string);

function getstrf():string;
function getdata(): TEMList2;
function getnumofcl(): integer;
function getnumofit(): integer;

function getP(j:integer): double;
function getV(j:integer): double;
function getU(i,j:integer): double;
function getN(): integer;
function getD(i,j:integer): double;
function get_d():integer;

function propose(nn,j:integer):double;
function cluster(i:integer):integer;
private
procedure init;
PROCEDURE new_old;
function P_x_j(nn,j:integer):double;
function P_j_x(nn,j:integer):double;
procedure P_x;
procedure P_x_old;
function P_x_j_old(nn,j:integer):double;
function P_j_x_old(nn,j:integer):double;
procedure iteration;
function dist(nn,j:integer):double;


function pow(c,s:double):double;
procedure EMerror(s:string);
end;

implementation

function TEM.getP(j:integer):double;
begin
getP:=P[j];
end;

function TEM.getV(j:integer):double;
begin
getV:=v[j];
end;

function TEM.getU(i,j:integer):double;
begin
getU:=u[i,j];
end;
function TEM.getN():integer;
begin
getN:=N;
end;

function TEM.get_d():integer;
begin
get_d:=d;
end;

function TEM.getD(i,j:integer):double;
begin
getD:=data[i,j];
end;

constructor TEM.create(ldata:TEMList2; MM:integer; CI:integer);
begin
inherited create();
setdata(ldata);
setnumofcl(MM);
setnumofit(CI);
end;

constructor TEM.create();
begin
inherited create();
end;

destructor TEM.destroy;
begin
setlength(Data,0,0);
setlength(Min,0);
setlength(Max,0);
setlength(P,0);
setlength(u,0,0);
setlength(v,0);
setlength(P_old,0);
setlength(u_old,0,0);
setlength(v_old,0);
setlength(P_x_a,0);
setlength(P_x_a_old,0);
inherited destroy();
end;

procedure TEM.learn;
var
i:integer;
begin
init;
for i:=0 to Cntiter do
begin
iteration;
end;
end;

procedure TEM.test(ldata:TEMList2);
begin
if d=high(ldata[0])+1 then
begin
data:=copy(ldata);
N:=high(ldata)+1;
{display(); }
end
else EMerror('ERROR# Size of learn and test data is not equal');
end;

procedure TEM.init;
var
i,j,nn:integer;
vvar:double;
begin
vvar:=0.0;
setlength(Min,d);
setlength(Max,d);
setlength(P,M);
setlength(u,M,d);
setlength(v,M);
setlength(P_old,M);
setlength(u_old,M,d);
setlength(v_old,M);
setlength(P_x_a,N);
setlength(P_x_a_old,N);
for i:=0 to d-1 do
begin
Min[i]:=data[0,i];
Max[i]:=data[0,i];
for nn:=1 to N-1 do
begin
if Min[i] > data[nn,i] then min[i]:=data[nn,i]
else if max[i] < data[nn,i] then max[i]:=data[nn,i];
end;
end;
for i:=0 to d-1 do vvar:=vvar+(Max[i]-Min[i])*(Max[i]-Min[i])/12/d;
for j:=0 to M-1 do
begin
P[j]:=1.0/M;
v[j]:=vvar/4+random*vvar/4;
for i:=0 to d-1 do u[j,i]:=(Max[i]-Min[i])/2+(random-0.5)*(Max[i]-Min[i])/2;
end;
end;

procedure TEM.setdata(ldata:TEMList2);
begin
data:=copy(ldata);
N:=high(ldata)+1;
d:=high(ldata[0])+1;
end;

procedure TEM.setnumofcl( MM:integer);
begin
M:=MM;
end;

procedure TEM.setnumofit( CI:integer);
begin
cntiter:=CI;
end;

procedure TEM.setstrf(s: string);
begin
strf:=s;
end;

function TEM.getstrf():string;
begin
getstrf:=strf;
end;

function TEM.getdata():TEMList2;
begin
getdata:=data;
end;

function TEM.getnumofcl():integer;
begin
getnumofcl:=M;
end;

function TEM.getnumofit():integer;
begin
getnumofit:=cntiter;
end;

procedure TEM.new_old;
Var
i,j:integer;
begin
for j:=0 to M-1 do
begin
P_old[j]:=P[j];
v_old[j]:=v[j];
for i:=0 to d-1 do u_old[j,i]:=u[j,i];
end;
end;

function TEM.P_x_j(nn,j:integer):double;
var
i:integer;
e:double;
begin
e:=0.0;
for i:=0 to d-1 do e:=e+(data[nn,i]-u[j,i])*(data[nn,i]-u[j,i]);
e:=e/(-2*v[j]*v[j]);
if e<-1000 then P_x_j:=1E-12
else P_x_j:=exp(e)/pow(2*Pi*v[j]*v[j],d/2.0);
end;

function TEM.P_j_x(nn,j:integer):double;
begin
P_j_x:=P_x_j(nn,j)*P[j]/P_x_a[nn];
end;

procedure TEM.P_x;
var
nn,j:integer;
temp:double;
begin
for nn:=0 to N-1 do
begin
temp:=0.0;
for j:=0 to M-1 do temp:=temp+P_x_j(nn,j)*P[j];
P_x_a[nn]:=temp;
end;
end;

function TEM.P_x_j_old(nn,j:integer):double;
var
i:integer;
e:double;
begin
e:=0.0;
for i:=0 to d-1 do e:=e+(data[nn,i]-u_old[j,i])*(data[nn,i]-u_old[j,i]);
e:=e/(-2*v_old[j]*v_old[j]);
if e<-1000 then P_x_j_old:=1E-12
else P_x_j_old:=exp(e)/pow(2*Pi*v_old[j]*v_old[j],d/2.0);
end;

function TEM.P_j_x_old(nn,j:integer):double;
begin
P_j_x_old:=P_x_j_old(nn,j)*P_old[j]/P_x_a_old[nn];
end;

procedure TEM.P_x_old;
var
nn,j:integer;
temp:double;
begin
for nn:=0 to N-1 do
begin
temp:=0.0;
for j:=0 to M-1 do temp:=temp+(P_x_j_old(nn,j))*(P_old[j]);
P_x_a_old[nn]:=temp;
end;
end;

procedure TEM.iteration;
var
nn,j,i:integer;
denom: double;
sum:double;
begin
new_old;
P_x;
P_x_old;
for j:=0 to M-1 do
begin
denom:=0.0;
for nn:=0 to N-1 do denom:=denom+P_j_x_old(nn,j);
for i:=0 to d-1 do
begin
u[j,i]:=0.0;
for nn:=0 to N-1 do u[j,i]:=u[j,i]+P_j_x_old(nn,j)*data[nn,i];
u[j,i]:=u[j,i]/denom;
end;
v[j]:=0.0;
for nn:=0 to N-1 do
begin
sum:=0.0;
for i:=0 to d-1 do sum:=sum+pow(Data[nn,i]-u[j,i],2);
v[j]:=v[j]+sum*P_j_x_old(nn,j);
end;
v[j]:=sqrt(v[j]/(denom*d));
P[j]:=denom/N;
end;
end;

function TEM.dist(nn,j:integer):double;
var
sum:double;
i:integer;
begin
sum:=0.0;
for i:=0 to d-1 do
sum:= sum+pow(u[j,i]-data[nn,i],2);
dist:=sqrt(sum);
end;

function TEM.propose(nn,j:integer):double;
var
sum: double;
i: integer;
begin
sum:=0.0;
for i:=0 to M-1 do sum:=sum+dist(nn,i);
if M<=1 then propose:=1
else propose:=(sum-dist(nn,j))/((M-1)*sum);
end;

function TEM.cluster(i:integer):integer;
var
j,k:integer;
maxp,prp:double;
begin
maxp:=0;
k:=0;
for j:=0 to M-1 do
begin
prp:=propose(i,j);
if(maxp<prp)then
begin
maxp:=prp;
k:=j;
end;
end;
cluster:=k;
end;


function TEM.pow(c,s:double):double;
begin
if c=0 then pow:=0
else pow:=exp(s*ln(abs(c)));
end;

procedure TEM.EMerror(s:string);
begin
err:=s;
end;
end.