uincoord.pas

clusterfilesrev 最新的分类聚类代码

      end;

    Reset(inf);                  //   僼傽僀儖傪撉傒弌偟梡偵愝掕

    with StringGrid1 do
      begin
        readln(inf, v);
        RowCount:=v;
        readln(inf, v);
        ColCount:=v;
        for i:=2 to RowCount-1 do
          Cells[0,i]:=' 懳徾'+IntToStr2(i-1);
        for j:=2 to ColCount-1 do
          Cells[j,0]:=' 懏惈'+IntToStr(j);
        for i:=1 to RowCount-1 do
          for j:=1 to ColCount-1 do
            begin
              readln(inf,s);
              Cells[j,i]:=s;
            end;
      end;

    CloseFile(inf);
end;

procedure TFCoord.PButtonClick(Sender: TObject);
var   pout : TextFile;
      h, i    : Longint;

  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;

begin
      PrintDialog1.execute;
      with printer do
        begin
          AssignPrn(pout);
          Rewrite(pout);

          with Canvas.Font do
            begin
                Name:='俵俽 柧挬';
                size:=12;
            end;

          writeln(pout);
          writeln(pout);
          writeln(pout,'Data =');
          writeln(pout);
          writeln(pout);

          with StringGrid1 do
            for h:=0 to RowCount-1 do
              begin
                for i:=0 to ColCount-1 do
                  write(pout,AdjStrL(Cells[i,h],12));
                writeln(pout);
              end;
          CloseFile(pout);
        end;
end;


//   Excel屳姺偺偨傔CSV宍幃偱僼傽僀儖弌椡
procedure TFCoord.WRCSVButtonClick(Sender: TObject);
var outf : TextFile;
    FN   : string;
    h, i : Longint;

  function CheckCSV( s : string ) : string;
    begin
        if Length(s) < 5 then s:=s+'.csv'
        else if  (Copy(s, Length(s)-3,4) <> '.csv')
               and
                 (Copy(s, Length(s)-3,4) <> '.CSV') then s:=s+'.csv';
        CheckCSV:=s;
    end;

begin
    with SaveDialog1 do        //   曐懚梡僼傽僀儖偺柤慜偺愝掕
      begin
          Title:='僼傽僀儖柤';
          Filter:='CSV files (*.csv)|*.CSV';
          FileName:='';
          if not Execute then exit;
          FN:=CheckCSV(FileName);
          AssignFile(outf,FN);
          Filter:='';
      end;

    Rewrite(outf);            //  僼傽僀儖傪彂偒弌偟梡偵愝掕

    with StringGrid1 do
      begin
        for h:=1 to RowCount-1 do
          begin
            write(outf, Cells[1,h]);
            if ColCount > 2 then
              for i:=2 to ColCount-1 do
              write(outf, ',', Cells[i,h]); //  僨乕僞偺彂偒弌偟
            writeln(outf);
          end;
      end;

    CloseFile(outf);
end;


//   Excel偵傛傞CSV宍幃弌椡偺僨乕僞僼傽僀儖傪撉傒崬傓
procedure TFCoord.RDCSVButtonClick(Sender: TObject);
var inf : TextFile;
    s   : string;
    i   : Longint;
    SL   : TStringList;
begin
    with OpenDialog1 do        //   曐懚梡僼傽僀儖偺柤慜偺愝掕
      begin
          Title:='僼傽僀儖柤';
          Filter:='CSV files (*.csv)|*.CSV';
          FileName:='';
          if not Execute then exit;
          AssignFile(inf,FileName);
          Filter:='';
      end;

    Reset(inf);            //  僼傽僀儖傪彂偒弌偟梡偵愝掕
    SL:=TStringList.Create;
    readln(inf, s);
    SL.CommaText:=s;

    with StringGrid1 do
      begin
        ColCount:=SL.Count+1;
        RowCount:=2;
        for i:=2 to SL.Count do
          begin
            Cells[i,0]:=' 懏惈'+IntToStr2(i-1);
            Cells[i,1]:=SL.Strings[i-1];
          end;

        repeat
          readln(inf, s);
          SL.CommaText:=s;
          RowCount:=RowCount+1;
          Cells[0,RowCount-1]:=' 懳徾'+IntToStr2(RowCount-2);
          for i:=1 to SL.Count do
            Cells[i,RowCount-1]:=SL.Strings[i-1];
        until  eof(inf);
      end;  

    SL.Free;
    CloseFile(inf);
end;


//    楍偺捛壛
procedure TFCoord.AddColButtonClick(Sender: TObject);
var   i, j, pos : Longint;
begin
      with StringGrid1 do
        begin
            pos:=Selection.Left;
            if 0 < pos then
              begin
                ColCount:=ColCount+1;
                Cells[ColCount-1,0]:=' 懏惈'+IntToStr2(ColCount-2);
                for j:=1 to RowCount-1 do
                  Cells[ColCount-1,j]:=' ';
                if (pos < ColCount-2) then
                  begin
                    for i:=ColCount-1 downto pos+2 do
                      for j:=1 to RowCount-1 do
                        begin
                          Cells[i,j]:=Cells[i-1,j];
                        end;

                    for j:=1 to RowCount-1 do
                      Cells[pos+1,j]:=' ';
                  end;
              end;
        end;
end;


//    楍偺嶍彍
procedure TFCoord.DelColButtonClick(Sender: TObject);
var pos, i, j : Longint;
begin
    with StringGrid1 do
      begin
        pos:= Selection.Left;     //  慖戰峴偺愝掕
        if (pos > 1) and (ColCount > 2) then
          begin
            //   僙儖偺抣偺堏摦
            if (pos < ColCount-1) then
              begin
                for i:=pos to ColCount-2 do
                  for j:=1 to RowCount-1 do
                    Cells[i,j]:=Cells[i+1,j];   //  楍扨埵偺堏摦
              end;

            //   嵟屻偺楍傪嶍彍
            ColCount:=ColCount-1;
            if ColCount > 2 then
              for i:=2 to ColCount-1 do
                Cells[i,0]:=' 懏惈'+IntToStr2(i-1);
          end;
      end;
end;

//   嵗昗抣偺昗弨壔偵傛傞嫍棧偺寁嶼
procedure TFCoord.EucStdButtonClick(Sender: TObject);
var i, j, h : Longint;
    v, sum, ssum, mean, sd : extended;
begin
    with StringGrid1 do
      begin
        N:=RowCount-2;
        NDim:=ColCount-2;
        try
        for i:=1 to N do
          begin
            LObj[i]:=Cells[1,i+1];
            for j:=1 to NDim do
              Coord[i,j]:=StrToFloat(Cells[j+1,i+1]);
          end;
        except                             //   晄惓側僨乕僞
          ShowMessage('Error ===>  Cells['+IntToStr(i+1)+
                      ','+IntToStr(j)+'] = '+Cells[j,i+1]);
          Exit;   //   偙偺庤懕偒偺廔椆
        end;
      end;

    //   撉傒崬傒僨乕僞弌椡梡僼傽僀儖柤偺愝掕
    with OpenDialog1 do
      begin
          Title:='Output File';
          Filter:='';
          FileName:='';
          if not execute then exit;
          AssignFile(outf, FileName);
      end;
    Rewrite(outf);

    //  愝掕僨乕僞偺彂偒弌偟
    writeln(outf);
    writeln(outf,'擖椡僨乕僞...');
    for i:=1 to N do
      begin
        write(outf, i:3, ' : ', StrToL(LObj[i],10));
        for j:=1 to NDim do write(outf, Coord[i,j]:7:1);
        writeln(outf);
      end;

    //    嵗昗抣偺昗弨壔
    for j:=1 to NDim do
      begin
        sum:=0.0; ssum:=0.0;
        for i:=1 to N do
          begin  sum:=sum+Coord[i,j];  ssum:=ssum+sqr(Coord[i,j]);  end;
        mean:=sum/N;
        sd  :=sqrt((ssum/N)-sqr(mean));
        for i:=1 to N do Coord[i,j]:=(Coord[i,j]-mean)/sd;
      end;

    writeln(outf);
    writeln(outf,'昗弨壔擖椡僨乕僞...');
    for i:=1 to N do
      begin
        write(outf, i:3, ' : ', StrToL(LObj[i],10));
        for j:=1 to NDim do write(outf, Coord[i,j]:7:1);
        writeln(outf);
      end;

    for i:=2 to N do
      for j:=1 to i-1 do
        begin
            v:=0.0;
            for h:=1 to NDim do
              v:=v+sqr(Coord[i,h]-Coord[j,h]);
            Dist[i,j]:=sqrt(v);
        end;


    ckFSim:=1;    //   偙偺僼僅乕儉傪惗惉偟偨儐僯僢僩UClusterRev.pas偵偍偗傞
    Close;        //   repeate...until暥傪敳偗弌偡
end;

end.