Einzelnen Beitrag anzeigen

Horst_

Registriert seit: 22. Jul 2004
Ort: Münster Osnabrück
116 Beiträge
 
#79

AW: Doppel schnell aus Lise löschen.

  Alt 11. Dez 2014, 13:00
Hallo,

wie kannst Du Dir so sicher sein?
Ich weiß nicht, wie bei Dir uFloatPoint.pas aussieht.
Wahrscheinlich habe ich jetzt eine falsche Version.

Delphi-Quellcode:
program FloatPointsTest;

{$IFDEF FPC}
  {$MODE Delphi}
{$ELSE}
  {$APPTYPE console}
{$ENDIF}

uses
  sysutils,uFloatPoints in 'uFloatPoints.pas';
// const cEps = 1e-4 in uFloatPoints
var
  OrgPoints,
  FLoatPoints,
  TmpFP : TFloatPoints;

function FloatRandom(const AFrom, ATo: double): double;
begin
  FloatRandom := random *(ATo - AFrom)+AFrom;
end;

procedure Mischen(var FP:TFloatPoints);
var
  i,j: integer;
begin
  For i := FP.Count-1 downto 1 do
  begin
    j := Random(i);
    FP.Exchange(i,j);
  end;
end;

procedure CreateNew(var FP:TFloatPoints);
var
  I, N: integer;
  Faktor : double;
begin
  randomize;
  FP.Clear;
  N := 5000;
  Writeln(n,' neue');
  Faktor := 0.1*cEps;
  for I := 1 to N do
    FP.AddXY(Faktor*I,-Faktor*I);
  writeln(FP.Count,' insgesamt' );
end;

function CheckforDoubles(var FP :TFloatPoints;check:integer): boolean;
var
  I, J: integer;
begin
  Result := true;
  Write('Vor check double ',FP.Count);
  case check of
    0: FP.FastRemoveDoubles;
    1: FP.RemoveDoubles;
    2: FP.RemoveDoublesII;
  end;
  Write(' Nach check double ',FP.Count);
  Write(' Check ');

  for I := 0 to FP.Count - 2 do
    for J := I + 1 to FP.Count - 1 do
      if SameFloatPoint(FP[I], FP[J]) then
        begin

          write(i:10,j:10,' ');
{
          writeln(FP[I].x:10:7,FP[I].y:10:7);
          writeln(FP[j].x:10:7,FP[j].y:10:7);
          writeln(sqrt(sqr(FP[j].x-FP[i].x)+
                      sqr(FP[j].y-FP[i].y)));
}

          Result := false;

          EXIT;
        end;
end;

var
  i,j: integer;
begin
  randomize;
  OrgPoints := TFloatPoints.Create;
  CreateNew(OrgPoints);
  For i := 1 to 10 do
  begin
    FLoatPoints := OrgPoints.Copy;
    Mischen(FLoatPoints);
    TmpFp := FLoatPoints.Copy;
    FLoatPoints.Free;
    For j := 0 to 2 do
    begin
      FLoatPoints := TmpFp.Copy;
      writeln(CheckforDoubles(FloatPoints,j));
      FLoatPoints.Free;
    end;
    TmpFp.free;
  end;
end.
Die Ausgabe sieht nicht sehr günstig aus.
Code:
5000 neue
5000 insgesamt
Vor check double 5000 Nach check double 4999 Check         0         1 FALSE
Vor check double 5000 Nach check double 467 Check       465       466 FALSE
Vor check double 5000 Nach check double 625 Check TRUE
Gruß Horst
Angehängte Dateien
Dateityp: pas uFloatPoints.pas (9,1 KB, 1x aufgerufen)
  Mit Zitat antworten Zitat