Курсовой проект групп 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.