uclustercwrev.pas

clusterfilesrev 最新的分类聚类代码

            for i:=1 to NDim do
              CoordV[i]:=(L^.NMem*L^.CoordV[i]+R^.NMem*R^.CoordV[i])
                          /(L^.NMem+R^.NMem);
            NMem:=L^.NMem+R^.NMem;
        end;

      //  嫍棧儕僗僩偺峏怴  
      if NC > 3 then
        begin
          for i:=1 to NC-1 do
            if (ListC[i].id <> c1) and (ListC[i].id <> c2) then
              begin
                  DistEnd:=DistEnd+1;         // 惗惉偝傟偨僋儔僗僞偲偺嫍棧傪
                  with ListDist[DistEnd] do   // 儕僗僩偵晅偗壛偊傞
                    begin
                        id1:=ListC[i].id;
                        id2:=serNC;
                        d:=CalcWardD(id1,c1,c2);
                    end;
              end;

          //  惗惉偝傟偨僋儔僗僞偵暪崌偝傟偨僋儔僗偲偺嫍棧僨乕僞偺嶍彍
          i:=1;
          repeat
            if (ListDist[i].id1 = c1) or (ListDist[i].id1 = c2) or
               (ListDist[i].id2 = c1) or (ListDist[i].id2 = c2)
               then
                 begin
                   for j:=i to DistEnd-1 do
                     ListDist[j]:=ListDist[j+1];
                     DistEnd:=DistEnd-1;
                     i:=i-1;
                 end;
            i:=i+1;
          until i >= DistEnd;

          //  惗惉偝傟偨僋儔僗僞偵暪崌偝傟偨僋儔僗僞傪儕僗僩偐傜嶍彍偡傞
          i:=1;
          repeat
              if (ListC[i].id = c1) or (ListC[i].id = c2)
                then begin
                  if i < NC then
                    for j:=i to NC-1 do ListC[j]:=ListC[j+1];
                  NC:=NC-1;
                  i:=i-1;
                end;

              i:=i+1;
          until i > NC;

          MakeClustersWardD;   //  僋儔僗僞偺惗惉傪嵞婣揑偵峴偆
        end;

  end;   {   MakeClustersWardD   }


var
  ph,                    //  僾儕儞僞弌椡偵偍偗傞暥帤楍偺崅偝
  pw,                    //  暥帤楍偺婎杮挿
  ps : Longint;          //  僾儕儞僞弌椡偵偍偗傞墶曽岦婎杮堏摦検
  pwunit : extended;     //  嫍棧丒旕椶帡搙偺婎杮検


//   僾儕儞僞弌椡偵偍偗傞墶曽岦偺埵抲
function xpos( y : extended ) : Longint;
  begin
           xpos := 2*pw + round(ps*y/pwunit);
  end;

//  僾儕儞僞弌椡偵偍偗傞廲曽岦偺埵抲
function ypos( x : extended ) : Longint;
  begin
           ypos := round( (x+2)*ph*1.2 );
  end;

//   庽忬恾偺嵞婣揑嶌惉
procedure CheckCluster( c : PntrC );
  begin
      with Printer, Canvas do
        begin
          if c^.L = nil    //  崁栚偺昤夋弌椡
            then
              begin
                cpos:=cpos+dgap;
                c^.x:=cpos;        //  廲曽岦偺埵抲
                TextOut(xpos(0.0)-TextWidth(LObj[c^.id]+' '),
                        ypos(cpos)-(ph div 2),
                        LObj[c^.id] );
              end
            else          //  壓埵僋儔僗僞偺扵嶕
              begin
                //   嵞婣揑扵嶕
                CheckCluster( c^.L ); CheckCluster( c^.R );

                //   偙偺僋儔僗僞c^偺廲曽岦偺埵抲
                c^.x:=0.5*(c^.L^.x + c^.R^.x);

                //   僋儔僗僞c^.L^偲僋儔僗僞c^傪偮側偖
                MoveTo(xpos(c^.L^.y),ypos(c^.L^.x));
                LineTo(xpos(c^.y),   ypos(c^.L^.x));

                //   僋儔僗僞c^.R^偲僋儔僗僞c^傪偮側偖
                LineTo(xpos(c^.y),   ypos(c^.R^.x));
                LineTo(xpos(c^.R^.y),ypos(c^.R^.x));
              end;
        end;
  end;

//  庽忬恾偺嶌惉
procedure DrawTree;
  begin
      FMain.PrintDialog1.execute;
      with Printer do
        begin
          BeginDoc;

          //    僾儕儞僞偱偺婎杮僒僀僘偺愝掕
          with Canvas do
            begin
                Font.Size:=StrToInt(FMain.FontEdit.Text);  //12;
                ph:=TextHeight('X');
                pw:=TextWidth('WWWWW');
                ps:=pw;
                pwunit:=ListC[NC].p^.y/n;
                if (2+n+3)*pw > PageWidth
                  then ps:=(PageWidth-2*pw) div (n+5)
            end;

          dgap:=1.0;   //  崁栚摉偨傝偺堏摦検
          cpos:=2.0;   //  崁栚偺埵抲

          with Canvas do
            begin
              //   栚惙傝偺昤夋
              MoveTo(xpos(0.0),ypos(1.5));
              LineTo(xpos(0.0),ypos(1.25));
              LineTo(xpos(ListC[NC].p^.y),ypos(1.25));
              LineTo(xpos(ListC[NC].p^.y),ypos(1.5));
              TextOut(xpos(0.0),ypos(1.7),'0.0');
              TextOut(xpos(ListC[NC].p^.y),ypos(1.7),
                      FloatToStrF(ListC[NC].p^.y,ffFixed,9,2));
              case DistType of
                     DCentroid  : TextOut(xpos(0.0), ypos(0.1),'廳怱朄');
                     DWard      : TextOut(xpos(0.0), ypos(0.1),'Ward朄');
              end;
            end;

          CheckCluster( ListC[NC].p);   //   庽忬恾偺嵞婣揑昤夋

          EndDoc;
        end;
  end;   {   DrawTree   }


//   僋儔僗僞偺攑婞傪嵞婣揑偵峴偆
procedure ClearC( c : PntrC );
  begin
          if c^.L = nil
            then
              begin
                dispose(c);
              end
            else
              begin
                ClearC( c^.L ); ClearC( c^.R );
                dispose(c);
              end;
  end;

//  僋儔僗僞偺攑婞
procedure ClearTree;
  begin
          ClearC( ListC[NC].p );
  end;


//  暥帤楍傪嵍媗偱巜掕偟偨挿偝L偺傕偺偵曄姺偡傞
function AdjStrL( s : string; L : integer ) : string;
  var w, i : integer;
  begin
      w:=Length(s);
      if w < L then
        for i:=1 to L-w do s:=s+' ';
      AdjStrL:=s;
  end;





//    嵗昗抣僨乕僞偺僋儔僗僞暘愅
procedure TFMain.CoordButtonClick(Sender: TObject);
var i, j, k : Longint;

  function StrToL( s : string; L : Longint ) : string;
    var w, i : Longint;
    begin
        w:=Length(s);
        if w < L then
          for i:=1 to L-w do s:=s+' ';
        StrToL:=s;
    end;

begin
    //   懏惈抣僨乕僞擖椡梡僼僅乕儉偺惗惉
    FCoord:= TFCoord.Create(Application);
    FCoord.Show;
    ckFSim:=0;
    repeat
        Application.ProcessMessages;
    until ckFSim <> 0;
    ExitButton.SetFocus; UpDate;

    if DistType = DCentroid then
      begin
        writeln(outf);
        writeln(outf,'嶼弌偝傟偨嫍棧...');
        for i:=1 to n do
          begin
            write(outf, AdjStrL(LObj[i],10));
            if i > 1 then
              for j:=1 to i-1 do
                write(outf, AdjStrL(FloatToStrF(Dist[i,j],ffGeneral,7,1),10));
            writeln(outf);
          end;
      end;
 
    //   嫍棧儕僗僩偺嶌惉
    DistEnd:=0;
    for i:=2 to n do
      for j:=1 to i-1 do
        begin
            DistEnd:=DistEnd+1;
            with ListDist[DistEnd] do
              begin
              //    id1:=i; id2:=j;
                  id1:=j;  id2:=i;
                  d:=0.0;
                  for k:=1 to NDim do d:=d+sqr(Coord[i,k]-Coord[j,k]);
                  if DistType = DWard then d:=d/2;
              end;
        end;

    //   崁栚偵懳墳偡傞僋儔僗僞傪昞偡僆僽僕僃僋僩偺儕僗僩偺嶌惉
    NC:=n;
    for i:=1 to n do
      with ListC[i] do
        begin
            id:=i;
            new(p);
            with p^ do
              begin
                  id:=i;
                  y :=0.0;
                  L:=nil;  R:=nil;
                  NMem:=1;
                  for j:=1 to NDim do
                    CoordV[j]:=Coord[i,j];
              end;
        end;
    serNC:=n;

    case DistType of
           DCentroid   :  MakeClustersCentroidD;
           DWard       :  MakeClustersWardD;
           else      begin
                         ShowMessage('Invalid value of DistType');
                         CloseFile(outf);
                         Close;
                     end;
    end;

    DrawTree;       //   庽忬恾偺昤夋

    ClearTree;      //   僋儔僗僞偺攑婞

    CloseFile(outf);
    ShowMessage('Calculation ended. Output File = '+
                 UInCoordCW.FCoord.OpenDialog1.FileName);

    Close;
end;

end.