Registriert seit: 22. Jul 2004
Ort: Münster Osnabrück
116 Beiträge
|
AW: Doppel schnell aus Lise löschen.
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
|
|
Zitat
|