Doppel schnell aus Liste löschen.

[Bjoerk]

Ok. Thanx. Schau ich mir an.

Als letzter Versuch fäll tmir noch das ein? Der Quicksort ist ja unfassbar schnell. Ist das so korrekt? :gruebel:

Delphi-Quellcode:

function SortCompareX(const A, B: TFLoatPoint): integer;
const
  Eps = 1E-4;
begin
  Result := CompareValue(A.X, B.X, Eps);
end;

function SortCompareY(const A, B: TFLoatPoint): integer;
const
  Eps = 1E-4;
begin
  Result := CompareValue(A.Y, B.Y, Eps);
end;

function SortCompareXY(const A, B: TFLoatPoint): integer;
begin
  if SortCompareX(A, B) = 0 then
    Result := SortCompareY(A, B)
  else
    Result := 0;
end;

procedure TFloatPoints.Sort;
begin
  if FCount > 1 then
  begin
    QuickSort(0, FCount - 1, SortCompareX);
    QuickSort(0, FCount - 1, SortCompareXY);
  end;
end;

[Namenloser]

Ich bezweifel es, aber einen Gegenbeweis kann ich jetzt nicht direkt liefern.

Ein paar Dinge, die man berücksichtigen sollte:
- Du hast bei Quicksort keinen Einfluss darauf, welche Paare miteinander verglichen werden und in welcher Reihenfolge
- Die „Gleichheit“ von Float-Werten ist keine Äquivalenzrelation, die Transitivität ist nicht erfüllt. Also macht es eben wohl einen Unterschied in welcher Reihenfolge die Elemente verglichen werden.
- Quicksort ist nicht stabil. Bei mir schrillen deshalb die Alarmglocken, wenn ich sehe, dass du zwei Sortiervorgänge direkt hintereinander ausführst. Was auch immer du dir davon erhoffst, wird nicht erfüllt sein.

Ich denke, man kann dieses Problem prinzipiell nicht mit eindimensionaler Sortierung lösen, egal was für eine ausgeklügelte Sortierung man sich einfallen lässt.

[Bjoerk]

Der QuickSort hat die unangenehme Angewohnheit, daß wenn es Beispielsweise in einer Adressenverwaltung 2 Hans Müller in 12345 Berlin gibt, und man die Adressen nach Postleitzahl sortiert, daß einmal der eine und einmal der andere Müller vorne stehen kann. M.E. hat das hier aber keinen Einfluß, weil identisch und hintereinander (Wenn 2 Durchläufe). Ich weiß es aber eben auch nicht genau .. :cyclops:

[Namenloser]

Das Ding ist, dass durch deinen zweiten Sortiervorgang der erste theoretisch komplett zunichte gemacht wird. Instabil heißt ja gerade, dass eine wie auch immer geartetet Vorsortierung nicht erhalten bleibt. Wenn der erste Sortiervorgang also irgendeinen Einfluss hat, dann ist das lediglich Zufall, und du kannst dich im Allgemeinen nicht darauf verlassen.

[Horst_]

Hallo,

also wäre es geschickter alle Punkte nach x zu sortieren und anschliessend nur einen Bereich von x_center+-eps zu betrachten und diesen nach y zu sortieren und zu untersuchen.( Sweep-line )
Anschliessend wandert man um ein eps weiter.
Das ist viel Sortiererei, aber man kann sich merken, wie x_center+eps nach y sortiert war. Das wird im nächsten Schritt ja x_center-eps.Da bietet sich ja mergesort an.

Gruß Horst

[Dejan Vu]

Zitat:

Zitat von Namenloser (Beitrag 1282690)

Ich muss eure Euphorie leider trüben. Die Methode von Dejan Vu liefert unter Umständen falsche Ergebnisse.

Stimmt nicht. A,B und C wird als A,B,C sortiert. Der X-Wert ist für A,B und C wird als "identisch" angesehen, also wird nach Y sortiert und dann stimmt es.

Das ganze Verfahren hat einen ganz anderen Haken: Nehmen wir an, wir haben 3 Punkte (P1 - P3), die alle um 1E-4 (=eps) von einander entfernt sind. Sagen wir, in X-Richtung. Y ist überall identisch. (also P[i+1].X = P[i].X + eps*0.99). Welche Punkte sollen übrigbleiben? Es kommt darauf an, welchen Punkt ich als 'Referenz nehme'.
A) P1 ist Referenz. Dann ist P2 nahe an P1, also weg. P3 ist zu weit von P1 weg, bleibt also => (P1,P2,P3) => (P1,P3)
B) P2 ist Referenz. Sowohl P1 als auch P3 sind nahe an P2, also weg => (P1,P2,P3)=> (P2)

Hashmap funktioniert dann auch nicht, weil zwei eng nebeneinanderliegende Punkte in unterschiedliche Raster fallen könnten. Der eine Punkt P1 liegt ganz rechts im Quadrant X, und der andere Punkt P2 ganz links im Quadranten X+1 (also dem rechts daneben) und obwohl P2.X-P1.X < Eps, sind die Quadranten unterschiedlich: Mein Nachbar ist in einem anderen Bezirk (Berlin) als ich, genauso blöd, d.h. wir haben unterschiedliche Postleitzahlen :lol:

Wenn man das 'richtig' machen will, muss man die von Namenlosen erwähnten Ansätze verwenden.

Als grobe 'Entdoppelung' sollte das Rasterverfahren (nichts anderes ist ja die Sortierung und die Eliminierung mit Epsilon) jedoch ausreichen.

Man kann auch das zweistufige Verfahren von Horst_ nehmen, wobei man nach der Sortierung nach X die von mir o.g. Problematik berücksichtigen könnte. Aber ob das jetzt was bringt, glaube ich nicht, weil man ja wieder rastert.

Das Quicksort nicht stabil ist, ist hier unerheblich: Wenn A und B 'identisch' sind, ist es egal, ob erst A vor B ist oder umgekehrt. Nicht die Sortierung ist das Problem, sondern die Ordnungsfunktion ('Compare'), die eine willkürliche Rasterung vornimmt sowie die willkürliche Wahl eines 'Referenzpunktes' für die Bestimmung von Clustern. Hier müsste man für jeden Cluster den Punkt 'in der Mitte' nehmen und von dem aus alle Nachbarn (dx<eps und dy<eps) eliminieren.

[Bjoerk]

Stimmt. Leider.. Das Thema macht mich echt fertig. Horst, und wieso jetzt plötzlich das funzt? Keinen Plan.. Man findet im Netz über Delphi Koordinaten Sortieren fast nichts.

Delphi-Quellcode:

procedure TFloatPoints.ProbablyRemoveDoubles;
var
  I: integer;
begin
  SortbyX;
  for I := FCount - 1 downto 1 do
    if Util_SameFloatPoint(FItems[I], FItems[I - 1]) then
      Delete(I);
  SortbyY;
  for I := FCount - 1 downto 1 do
    if Util_SameFloatPoint(FItems[I], FItems[I - 1]) then
      Delete(I);
end;

Bis auf weiteres hab ich an den wichtigsten Stellen if List.IndexOf(Value) < 0 then List.Add(Value) ergänzt und ruf die RemoveDoubles gar nicht mehr auf. :wall:

[Dejan Vu]

Die Idee von Horst bringt doch nichts. Ob ich die Daten erst nach X sortiere, oder mit dem SamePoint gleich einmal durch, ist doch egal: Punkte, die bezüglich des X-Wertes nahe beieinander liegen, werden bezüglich des Y-Wertes sortiert. Somit liegen fast gleiche Punkte auch nebeneinander, weil sie durch die Vergleichsfunktion als 'Identisch' betrachtet werden.

Es wird keine totale Ordnung auf den numerischen X- und Y-Werten aufgebaut!

Such mal lieber nach kd-Baum oder 2D-Index. Oder frag den Namenlosen, der scheint Ahnung davon zu haben

[Namenloser]

Zitat:

Zitat von Dejan Vu (Beitrag 1282712)

Zitat:

Zitat von Namenloser (Beitrag 1282690)

Ich muss eure Euphorie leider trüben. Die Methode von Dejan Vu liefert unter Umständen falsche Ergebnisse.

Stimmt nicht. A,B und C wird als A,B,C sortiert. Der X-Wert ist für A,B und C wird als "identisch" angesehen, also wird nach Y sortiert und dann stimmt es.

Das Problem ist: Quicksort setzt eigentlich eine Halbordnung voraus. Der Fuzzy-Vergleich ist aber keine, da die Transitivität (a ≤ b und b ≤ c ⇒ a ≤ c) nicht erfüllt ist. Und zwar ist sie das dann nicht, wenn a und b nahe genug bei einander liegen um als „gleich“ zu gelten, und b und c auch, aber a und c nicht.

Ich bin mir nicht sicher, inwieweit einem das auf die Füße fallen kann. Aber man müsste jedenfalls erst mal beweisen, dass der Quicksort-Algorithmus unter diesen Voraussetzungen überhaupt funktioniert.

[Dejan Vu]

Doch, a, b und c werden bezüglich des X-Wertes als identisch angesehen.

Zitat:

Die Koordinaten sind z.B. A(10.0, 2.0), B(10.001, 2.0), C(10.0, 5.0). A und B sollen im Rahmen des Epsilons als identisch gelten.

Die Vergleichsfunktion "V" wird folgende Ergebnisse liefern:
V(A,B)=> 0
V(A,C)=> -1 (A<B)
V(B,C)=> -1 (B<C)

Also wird so sortiert (A,B,C) oder (B,A,C).... Aber egal wie, B (oder A) wird immer eliminiert.

Beweisen ist natürlich toll, aber kurzes Nachdenken reicht auch:
1. Der Sortieralgorithmus wird 'identische' Werte unmittelbar aufeinanderfolgend sortieren, jedoch in willkürlicher Reihenfolge.
2. Der Eliminationsalgorithmus wird jede Sequenz von 'identischen' Werten W1...WN durch W1 ersetzten, und die Werte W2...WN aus der Liste entfernen. Hierfür wird die gleiche Vergleichsfunktion wie beim Sortieren verwendet, d.h. die Definition von 'identisch' ist bei beiden Algorithmen die gleiche.

[Bjoerk]

Ich hab mehrere Tests mit dem Code #47 durchgeführt. Scheint zu stimmen. Weiß aber nicht wieso?

Falls jemand probieren möchte (Testform):

[Namenloser]

@Dejan Vu: Das war jetzt nicht auf das Beispiel bezogen sondern allgemein.

Solange es immer nur Paare von zusammengehörenden Punkten gibt, sollte es wohl kein Problem geben. Problematisch könnte es aber werden, wenn es mehr als zwei zusammengehörige Punkte gibt.

Könnte sein, dass du z.B. irgendwie in einer Reihe die Punkte a b c d hast, wobei jeder Punkt zu seinen Nachbarn, und nur zu seinen Nachbarn, „gleich“ ist. Dann könnte es womöglich passieren, dass der Algorithmus die Punkte durcheinanderwürfelt und a c b d daraus macht oder so, sodass anschließend wieder keine Duplikate erkannt werden. Genau überlegt habe ich es mir nicht, ich warne nur.

Allerdings ist eh etwas unklar, was in einem solchen Fall passieren soll, wie du ja auch schon angemerkt hast.

[Dejan Vu]

Perfekt ist das Verfahren nicht. Aber wir verstehen es wenigstens. Bei so einem Kd-Baum oder spacial indexes müsste ich mich erst mal reinfräsen.

Zitat:

Zitat von Bjoerk (Beitrag 1282771)

Ich hab mehrere Tests mit dem Code #47 durchgeführt. Scheint zu stimmen. Weiß aber nicht wieso?

Also darauf würde ich mich jetzt mal nicht verlassen. Der zweite Sortiervorgang könnte die Ordnung durcheinanderbringen (instabiles Sortierverfahren).

Klappt mein Code nicht? Immerhin wird nur 1x sortiert und schnell ist er auch und ich glaube auch, das er korrekt ist ;-). Und hör mit dem 'Delete' auf, das ist doch Grottenlangsam. :-)

[Bjoerk]

Hier nein. Das Delete ist der Witz an der Sache. Sonst würde es nicht funktionieren. SortX und SortY müssen auf verschiedene Listen angewendet werden, sonst hat man nur SortY (Siehe auch Namenloser).

[Horst_]

Hallo,

da bin ich missverstanden worden...
Beim Versuch mit kleinem eps

Delphi-Quellcode:

procedure TFloatPointsTestForm.RemoveDoublesButtonClick(Sender: TObject);
const
  Eps = 1E-3;

steigt das Programm sofort aus.

Gruß Horst

[Bjoerk]

Nein, ich hatte nur das als letzte Möglichkeit gesehen um nicht groß am Code ändern zu müssen. Gut. Dann wäre das jetzt geklärt, daß es auch so nicht geht. Danke Horst. Allerdings steigt das Progamm nicht aus, sondern eine MessageBox wird angezeigt, daß FLoatPoints.RemoveDoubles nicht erfolgreich war. Dann kann man das mit der Sort Variante hier vergessen. Daß ich sattdessen im Code nun auf if List.IndexOf(Value) < 0 prüfe bevor Elemente hinzugefügt werden hab ich ja schon geschrieben.

Edit: Man könnte auch zuerst nach x sortieren und in Listen mit gleichen X splitten und dann nach y sortieren und später wieder zusammenfügen. Hab jetzt aber kein Bock mehr auf das Thema (zumindest heute nicht mehr).

[EgonHugeist]

Zitat:

Zitat von Bjoerk (Beitrag 1282695)

Ok. Thanx. Schau ich mir an.

Als letzter Versuch fäll tmir noch das ein? Der Quicksort ist ja unfassbar schnell. Ist das so korrekt? :gruebel:

HybridSort oder RadixSort? Es geht so einiges, wenn man keinen zusätzlichen Code oder Speicher-Verbrauch in Betracht zieht.

[Bjoerk]

Ok. Sagt mir aber leider nix. :oops:

Hab doch noch Bock. :-D

Ungetestet:

Delphi-Quellcode:

procedure TFloatPoints.RemoveDoubles;
const
  Eps = 1E-4;
var
  X: double;
  I, J: integer;
  NewList, SortList: TFloatPoints;
begin
  NewList := TFloatPoints.Create;
  try
    SortList := TFloatPoints.Create;
    try
      SortByX;
      I := 0;
      while I < FCount do
      begin
        SortList.Clear;
        X := FItems[I].X;
        while (I < FCount) and (SameValue(X, FItems[I].X, Eps)) do
        begin
          SortList.Add(FItems[I]);
          Inc(I);
        end;
        SortList.SortByY;
        for J := SortList.Count - 1 downto 1 do
          if SameFloatPoint(SortList[J], SortList[J - 1]) then
            SortList.Delete(J);
        NewList.AddPoints(SortList);
      end;
      Assign(NewList);
    finally
      SortList.Free;
    end;
  finally
    NewList.Free;
  end;
end;

[EgonHugeist]

Zitat:

Zitat von Bjoerk (Beitrag 1282792)

Ok. Sagt mir aber leider nix. :oops:

Macht nix, google es mal. Radix baut eine zweite Liste auf(Speicher x2) aber die Raten sind unglaublich! Es existieren so einige Radix Übersetzunengen.
Alexandr's HybridSort schlägt die "kleine/niedliche" QuickSort Variante um's 1,5fache. Radix dagegen ... kommt auf den Fall an.. x10 oder viiiel mehr!

@Nameloser: QSort ist in der Lage "unendlich" sogar mit Zufalls Ergebnissen zu arbeiten! e.g. FastCode-Project -> SortBV(Ein validation Test betrachtet diese Variante), Alle noch X-mal schnelleren Interpretationen/Replacements können jedoch nur mit "exakten" Ergebnissen umgehen.

[Dejan Vu]

Zitat:

Zitat von Dejan Vu (Beitrag 1282775)

Klappt mein Code nicht?

Zitat:

Zitat von Bjoerk (Beitrag 1282776)

Hier nein.

Echt? Geht Doch.

Delphi-Quellcode:

Function ComparePoints(Const P1, P2 : TFloatPoint) : Integer;
Begin
  Result := SortCompareX(p1,p2);
  if Result = 0 then REsult := SortCompareY(p1,p2);
End;

procedure TFloatPoints.FastRemoveDoubles;
var
  i,j : Integer;

Begin
  QuickSort(0,Count-1,ComparePoints);
  j:=0;
  For i:=1 to Count - 1 do
    if ComparePoints(Fitems[i],fItems[j])<>0 then begin
      inc(j);
      fItems[j] := fItems[i];
    end;
  fCount := j;
End;

Oder hatte ich was anderes geschrieben?

Im älteren Code von dir schien aber die Quicksort-Methode nicht richtig zu sortieren, jedenfalls bei mir. Aber jetzt scheint alles in Ordnung zu sein.

[Bjoerk]

Nein, so kann man keine Koordinaten sortieren (Siehe auch Namenloser und Horst). BTW, bei deiner FastAddPoints, fehlen da nicht die FillChars, TFLoatPoint ist doch ein Record?

Sort muss z.B. so:

Delphi-Quellcode:

procedure TFloatPoints.Sort(const RemoveDoubles: boolean);
const
  Eps = 1E-4;
var
  X: double;
  I, J: integer;
  NewList, SortList: TFloatPoints;
begin
  if FCount > 1 then
  begin
    NewList := TFloatPoints.Create;
    try
      SortList := TFloatPoints.Create;
      try
        SortByX;
        I := 0;
        while I < FCount do
        begin
          SortList.Clear;
          X := FItems[I].X;
          while (I < FCount) and (SameValue(X, FItems[I].X, Eps)) do
          begin
            SortList.Add(FItems[I]);
            Inc(I);
          end;
          SortList.SortByY;
          if RemoveDoubles then
          begin
            for J := SortList.Count - 1 downto 1 do
              if SameFloatPoint(SortList[J], SortList[J - 1]) then
                SortList.Delete(J);
          end;
          NewList.AddPoints(SortList);
        end;
        Assign(NewList);
      finally
        SortList.Free;
      end;
    finally
      NewList.Free;
    end;
  end;
end;

[Dejan Vu]

Zitat:

Zitat von Bjoerk (Beitrag 1282826)

Nein, so kann man keine Koordinaten sortieren (Siehe auch Namenloser und Horst).

Natürlich kann man das. Beide liegen mit welchen Überlegungen daneben bzw. bestätigen meine Einschränkung:
Unter der Prämisse, das man mit den hier vorgestellten Verfahren eh kein vollständiges 'Ersetze Cluster von sehr nahe beieinanderliegenden Punkten durch einen Referenzpunkt und minimiere dabei die Gesamtanzahl der Punkte' bekommt, sind die Lösungen alle äquivalent. Dein Test "gibt es nach dem 'removeduplicates' noch 'identische' Punkte" meldet auch bei meinem einfachen Scan keine Doppelten. Was willst Du denn noch? Zeig mir doch einfach, *was* daran falsch sein soll. Oder lass es sein und mach weiter so im produzieren von Code :lol:

Edit: Nicht falsch verstehen, ich finde das Thema recht interessant, würde nur gerne wissen, was dich an der offensichtlich einfachsten und schnellsten Lösung stört?

[Bjoerk]

Bud, ich versteh dich nicht falsch. Mit eindimensionaler Sortierung kann man das hier (wenn überhaupt) nur bei mit stabilen Sortierverfahren so machen.

[Horst_]

Hallo,

ich habe endlich den casus cnactus gefunden.
Deine SortCompareX darf nur mit eps= 0 arbeiten.Ich habe wie blöd gesucht, warum größere x-Werte vor kleineren auftauchten....
Ich hab jetzt auf einem Kreis mit Radius cEps um Punkt A verglichen.
RemoveDoublesII behält die Daten in der Ausgangsliste, also muss kein extra Feld angelegt werden.

Delphi-Quellcode:

procedure TFloatPoints.RemoveDoublesII;
var
  I, j: integer;
  ll, ul: integer;// lower, upper limit
  tmpf : tFloatPoint;
begin
  SortByX;

  ll := Low(FItems);
  ul := ll;
  for i := ll + 1 to FCOunt-1 do
  begin
    tmpf := FItems[i];
    while (ll < ul) and (tmpf.X >= FItems[ll].X + cEps) do
      Inc(ll);
    IF ll>ul then
    begin
      Inc(ul);
      FItems[ul] := tmpF;
    end
    else
    Begin
      j := ll;
      while j <= ul do
      begin
        if SameFloatPoint(tmpF, FItems[j]) then
          Break;
        Inc(j);
      end;
      if j > ul then
      begin
        Inc(ul);
        FItems[ul] := tmpF;
      end
    end;
  end;
  FCount := ul+1;
end;

Einen Test mit N= 100000 empfehle ich nicht, denn der anschliessende Check auf Doppelte dauert ewig...
Gruß Horst

[Dejan Vu]

Zitat:

Zitat von Bjoerk (Beitrag 1282864)

Bud, ich versteh dich nicht falsch. Mit eindimensionaler Sortierung kann man das hier (wenn überhaupt) nur bei mit stabilen Sortierverfahren so machen.

Hmnjamnjgfrftslmf. Jain.
Vereinfachen wir das auf eine Dimension. Die zweite braucht man nicht für die Betrachtung
Sei : P1=irgendwas, P2=P1+eps, P3=P2+eps
Dann gilt: P1=P2, P2=P3 und P1<P3
Sortiermöglichkeiten (egal ob stabil oder instabil):
P1,P2,P3 => Es wird nur P2 wird eliminiert, P3 aber nicht
P2,P1,P3 => P1 und P2 wird eliminiert
andere Möglichkeiten gibt es nicht
Ist das dein Problem? Das wirst du immer haben... Also mit den hier beschriebenen Verfahren.

[Bjoerk]

Zitat:

Zitat von Horst_ (Beitrag 1282931)

Hallo,
ich habe endlich den casus cnactus gefunden.
Deine SortCompareX darf nur mit eps= 0 arbeiten.Ich habe wie blöd gesucht, warum größere x-Werte vor kleineren auftauchten....
Ich hab jetzt auf einem Kreis mit Radius cEps um Punkt A verglichen.
RemoveDoublesII behält die Daten in der Ausgangsliste, also muss kein extra Feld angelegt werden.

[.. Code ..]

Danke für den Code. Der gepostete Algo macht es aber leider nicht.

.. and (tmpf.X >= FItems[ll].X + cEps) do

weiß nicht recht..

Und das Eps von Null ist ja auch nur eins von 1E-15 oder so.

Anyway.

Bin eigentlich mit meinem Code #61 zufrieden. 100.000 Punkte 1..2 sec.

Edit: Man kann sich die zuzsätzlichen Listen auch sparen, wenn man direkt QuickSort(Von, Bis) durchführt. So fand ich's aber übersichtlicher.

LG
Thomas

[Horst_]

Hallo,

der gepostete Schnipsel soll nur das Vorgehen zeigen.
cEps ist global definiert in uFloatPoint.pas

In den angehängten Dateien ist es dann funktionstüchtig. ( Man kann sich das auch tatsächlich mal anschauen )
Es ging doch darum, das Deine Sortierung nicht wirklich aufsteigend sortiert, weil dort

Delphi-Quellcode:

Result := CompareValue(A.X, B.X, cEps);

immer eine Umgebung betrachtet wird.
Ich hatte auch mal sowas im Testprogramm:

Delphi-Quellcode:

  for I := 1 to N do
    FLoatPoints.AddXY(i*cEps/20,i);
  //Zufaellige Punkte in y minimal verschieben -> doppelte
  for I := FLoatPoints.Count-1 downto 0 do
    with FloatPoints[Random(N)] do
      FLoatPoints.AddXY(X, Y-0.5*eps);

Also werden in sehr kleinem x-Abstand Punkte erzeugt, die sich y-mäßig sehr stark unterscheiden.Man muss dabei die letzten 20 Punkte in x-Richtung betrachten.Deshalb funktioniert dann Dejan Vu Version nicht mehr.

Gruß Horst
P.S:
Wie kann man jetzt feststellen, das man nicht zuviele Punkte rausgeschmissen hat?
P.S.S:
Kann man den Titel ändern.
Irgendwas mit doppelten XY-Koordinaten löschen wäre angebrachter.

[Dejan Vu]

Zitat:

Zitat von Horst_ (Beitrag 1282957)

...Also werden in sehr kleinem x-Abstand Punkte erzeugt, die sich y-mäßig sehr stark unterscheiden.Man muss dabei die letzten 20 Punkte in x-Richtung betrachten.Deshalb funktioniert dann Dejan Vu Version nicht mehr...

Das probiere ich... So. Probiert. Klappt immer noch.

[Horst_]

Hallo,

das ist ja gut.
Man braucht ein paar wiederholbare Testfälle.Dazu sollte man random eigentlich weglassen.Damit man sieht, dass aus 1000 + 1000 verschobenene eben auch am Ende wieder 1000 werden.
Sonst wird ein Punkt öfter verschoben, und es belieben dann eben 1100 über.

Gruß Horst

[Dejan Vu]

Vollkommen richtig. Aber 1000 Punkte sind auch wieder 'ins Blaue geraten'. Drei oder vier sollten reichen. Hast Du denn eine Idee im Kopf, bei welchen Fällen es schiefgehen kann?

Ich bin mir sehr sicher, das die Eliminierung von trivialen Dopplungen (also P1 und P1' sehr nahe beieinander, aber sonst nichts in der Nähe) problemlos möglich ist.

Ich warte immer noch auf den Beleg (oder ein Beispiel), wo das eine Verfahren funktioniert, aber das andere nicht.

Oder: wir lassen den Murks und überlegen, was man eigentlich erreichen will: Was soll z.B. herauskommen, wenn ich eine ganze Punkteschar habe, die sehr eng beieinander liegt und bei der es einen Punkt Px gibt, der quasi in der Mitte dieses 'Clusters' liegt. Dann könnte ich alle Punkte dieses Clusters (bis auf den in der Mitte) eliminieren.
Also: Welches Ergebnis wird erwartet, wenn ich folgende Punkteschar erzeuge:

Delphi-Quellcode:

for i:=1 to 100000 do
  Points.AddXY (Eps*RandomRange(-1,1), Eps*RandomRange(-1,1));

[Horst_]

Hallo,

dann nimm doch 10 Punkte die schon nach x sortiert sind, Aber die Y-Werte gegeneinanderlaufen.

Delphi-Quellcode:

N := 5;
for I := 1 to N do
begin
  FLoatPoints.AddXY(i*cEps/N,i);
  FLoatPoints.AddXY(i*cEps/N,(N-I+1)+0.5*cEps);
end;

Gruß Horst

[EgonHugeist]

Delphi-Quellcode:

//v. 2012-05-16
//free for any use

unit ShaRadixSorts;

interface

type
  TShaRadixKey= function(Item: pointer): integer;

//Examples:
//to descending sort by integer field: ShaRadixSort(List, Count, ShaRadixKeyIntegerDesc);
//to ascending sort by int64 field: ShaRadixSort(List, Count, ShaRadixKeyCardinal, ShaRadixKeyInt64High);
procedure ShaRadixSort(List: pointer; Count: integer; RadixKey: TShaRadixKey; RadixKeyHigh: TShaRadixKey= nil);

function ShaRadixKeyInteger(Item: pointer): integer;
function ShaRadixKeyCardinal(Item: pointer): integer;
function ShaRadixKeyInt64High(Item: pointer): integer;

function ShaRadixKeyIntegerDesc(Item: pointer): integer;
function ShaRadixKeyCardinalDesc(Item: pointer): integer;
function ShaRadixKeyInt64HighDesc(Item: pointer): integer;

implementation

//ascending order, signed integers
function ShaRadixKeyInteger(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $80000000;
  end;

//ascending order, unsigned integers or low part of int64
function ShaRadixKeyCardinal(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^);
  end;

//ascending order, high (signed) part of int64
function ShaRadixKeyInt64High(Item: pointer): integer;
type
  PCardinalArray= ^TCardinalArray;
  TCardinalArray= array[0..1] of cardinal;
begin;
  Result:=PCardinalArray(Item)[1] xor $80000000;
  end;

//descending order, signed integers
function ShaRadixKeyIntegerDesc(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $7FFFFFFF;
  end;

//descending order, unsigned integers or low part of int64
function ShaRadixKeyCardinalDesc(Item: pointer): integer;
begin;
  Result:=Cardinal(Item^) xor $FFFFFFFF;;
  end;

//descending order, high (signed) part of int64
function ShaRadixKeyInt64HighDesc(Item: pointer): integer;
type
  PCardinalArray= ^TCardinalArray;
  TCardinalArray= array[0..1] of cardinal;
begin;
  Result:=PCardinalArray(Item)[1] xor $7FFFFFFF;
  end;

function Phase0(List, Temp, Cur: pointer; RadixKey: TShaRadixKey): integer;
const
  Skip: array[0..15] of integer= (0, 0, 0, 3, 0, 0, 6, 3, 0, 0, 0, 3, 12, 12, 12, 15);
var
  i, j, k, Zeros: integer;
begin;
  k:=0;
  for j:=-1024 to -1 do pIntegerArray(Temp)[j]:=k;

  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^);
    inc(pIntegerArray(Temp)[j and 255 - 1024]);
    inc(pIntegerArray(Temp)[j shr 8 and 255 - 768]);
    inc(pIntegerArray(Temp)[j shr 16 and 255 - 512]);
    inc(pIntegerArray(Temp)[j shr 24 - 256]);
    until Cur=List;

  j:=-1024; k:=-1; Zeros:=0;
  repeat;
    if j and 255=0 then begin;
      k:=-1; Zeros:=Zeros shl 8;
      end;
    i:=pIntegerArray(Temp)[j];
    if i=0 then inc(Zeros);
    inc(k,i);
    pIntegerArray(Temp)[j]:=k;
    inc(j);
    until j=0;

  k:=0; Zeros:=Zeros xor -1;
  for j:=1 to 4 do begin;
    k:=k+k;
    if Zeros and $FF=0 then inc(k);
    Zeros:=Zeros shr 8;
    end;
  Result:=Skip[k];
  end;

procedure Phase1(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) and 255;
    k:=pIntegerArray(Temp)[j-1024];
    pPointerArray(Temp)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-1024]:=k-1;
    until Cur=List;
  end;

procedure Phase2(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 8 and 255;
    k:=pIntegerArray(Temp)[j-768];
    pPointerArray(List)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-768]:=k-1;
    until Cur=Temp;
  end;

procedure Phase3(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 16 and 255;
    k:=pIntegerArray(Temp)[j-512];
    pPointerArray(Temp)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-512]:=k-1;
    until Cur=List;
  end;

procedure Phase4(List, Temp, Cur: pointer; RadixKey: TShaRadixKey);
var
  j, k: integer;
begin;
  repeat;
    dec(pPointer(Cur));
    j:=RadixKey(pPointer(Cur)^) shr 24;
    k:=pIntegerArray(Temp)[j-256];
    pPointerArray(List)[k]:=pPointer(Cur)^;
    pIntegerArray(Temp)[j-256]:=k-1;
    until Cur=Temp;
  end;

procedure ShaRadixSort(List: pointer; Count: integer; RadixKey: TShaRadixKey; RadixKeyHigh: TShaRadixKey= nil);
var
  Temp: array of pointer;
  Skip: integer;
begin;
  if Count<=0 then exit;
  SetLength(Temp, Count+1024);
  repeat;
    Skip:=Phase0(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 1=0 then Phase1(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 2=0 then Phase2(List, @Temp[1024], @Temp[Count+1024], RadixKey);
    if Skip and 4=0 then Phase3(List, @Temp[1024], @pPointerArray(List)[Count], RadixKey);
    if Skip and 8=0 then Phase4(List, @Temp[1024], @Temp[Count+1024], RadixKey);
    RadixKey:=RadixKeyHigh;
    RadixKeyHigh:=nil;
    until not Assigned(RadixKey);
  end;

end.

Das wäre mal eine sehr schnelle Radix Interpretation von Alexandr Sharahov. QuickSort is da echt langsam dagegen. Muß dir eigentlich nur noch deinen eigen Key basteln..

[Bjoerk]

Wow. Schau ich mir. Thanx.

Ich hab auch noch einen (allerdings wie gehabt mit Quicksort): :-D

Delphi-Quellcode:

procedure TFloatPoints.Sort;
const
  Eps = 1E-4;
var
  X: double;
  A, B: integer;
begin
  // Koordinaten können mit einem instabilen Sortierverfahren nicht eindimensional sortiert werden;
  // Wir wollen aber mit dem QuickSort sortieren, weil eben schnell;
  // Deshalb sortieren wir zuerst nach X (SortByX) und anschließend alle Punkte
  // mit den gleichen X-Werten nach Y (SortByY);
  // Wir sortieren auch desshalb, weil wir Doppel schnell rauslöschen wollen;
  // Wir sortieren also zunächst (die ganze Liste) nach X;
  QuickSort(0, FCount - 1, SortCompareX);
  // Jetzt suchen wir alle Punkte mit den gleichen X-Werten und sortieren diese nach Y;
  A := 0;
  while A < FCount do
  begin
     X := FItems[A].X; // Wir suchen Punkte mit diesem X-Wert;
     B := A; // A = Index des 1. aktuellen X-Wertes, B = Index des letzten aktuellen X-Wertes;
     while (B < FCount - 1) and (SameValue(X, FItems[B + 1].X, Eps)) do
       Inc(B);
     // Nun sortieren wir diesen Teil der Liste nach Y;
     if B > A then // Wenn es mehr als 1 Punkt gibt;
     begin
       QuickSort(A, B, SortCompareY);
       A := B; // Indices A bis B abgearbeitet;
     end;
     Inc(A); // Mit diesem Index geht es weiter;
  end;
end;

[EgonHugeist]

Habe das Teil selber noch nicht getestet. Bin wegen Zeos mit ihm in Kontakt.. Wirst so einige RTL Replacements von ihm in deiner Delphi IDE finden. CompareMem z.B.

Kannst dich aber auch Dejan anschließen und meinen wenige Code bringt die schnellsten Ergebnisse :thumb:

[Jens01]

Wenn das wirklich immer noch so lange dauert, könnte man vielleicht darüber nachdenken, ob Multithreading irgendwie hilfreich ist.
Habe mir gerade Dein Drawpad-Tutorial angeguckt. Genau verstanden habe ich es aber nicht, warum Du diese Löschorgie benötigst.

[Bjoerk]

Hi Bud,
nee, das dauert (mit #73) nicht (mehr) lange. So 1 bis 2 sec. beim Dxf Einlesen (Nur 1 mal erforderlich). Hier geht es um Fangpunkte, weil ohne diese ist die Zeichnerei eine Quälerei. Wichtig sind die Anzahl der Fangpunkte später beim Zeichenprozess (von neuen Objekten), weil diese bei MouseMove abgefragt werden (müssen). Deshalb kann man die auch nicht in einen Thread auslagern, weil die just in time zur Verfügung stehen müssen. Die Berechnung von weiteren Fangpunkten hab ich allerdings in einen Thread ausgelagert (z.B. Schnittpunkte). Das Programm prüft auf Fangpunkte in der Umgebung zur aktuellen Mausposition und wenn der Abstand zum nächsten Fangpunkt 1mm unterschreitet nimmt es den als MouseMove Punkt. Damit ist die Exaktheit der Zeichnung gewährleistet. Die Anzahl der Fangpunkte spielt also eine wichtige Rolle für einen flüssigen MouseMove Prozess. Und da in der Dxf viele Punkte doppelt vorhanden sind lösche ich die vorher raus. Mit #1 hat das eine Ewigkeit gedauert. Jetzt nicht mehr.

[Dejan Vu]

Zitat:

Zitat von Horst_ (Beitrag 1282967)

Hallo,

dann nimm doch 10 Punkte die schon nach x sortiert sind, Aber die Y-Werte gegeneinanderlaufen.

Delphi-Quellcode:

N := 5;
for I := 1 to N do
begin
  FLoatPoints.AddXY(i*cEps/N,i);
  FLoatPoints.AddXY(i*cEps/N,(N-I+1)+0.5*cEps);
end;

Gruß Horst

Welches Ergebnis erwartest Du? Ich habe das eben probiert und es bleiben 5 Punkte übrig.

[Bjoerk]

Also, ich verabschiede mich mal an der Stelle hier und danke allen für die freundliche Unterstützung. Mit ca. 100.000 Punkten und ca. 30.000 Doppel bin ich mit #61 bei 100 ms.

Delphi-Quellcode:

    FLoatPoints.Clear;
    N := 30000;
    for I := 1 to N do
      FLoatPoints.AddXY(FloatRandom(0, 10000), FloatRandom(0, 10000));
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoints[Random(N)]);
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoint(FloatPoints[I].X + Eps, FloatPoints[I].Y));
    for I := 0 to FLoatPoints.Count div 2 do
      FLoatPoints.Insert(Random(FLoatPoints.Count), FloatPoint(FloatPoints[I].X, FloatPoints[I].Y + Eps));
    FLoatPoints.RemoveDoubles;

LG
Thomas

[Horst_]

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

[Dejan Vu]

Zitat:

Zitat von Horst_ (Beitrag 1283048)

(1)wie kannst Du Dir so sicher sein?...(2) Wahrscheinlich habe ich jetzt eine falsche Version.

(1) Ich habe es ausprobiert (sonst würde ich hier nicht so rumkrakeelen)
(2) Anders kann ich mir das nicht erklären. Ich hab hier kein Delphi (nur privat) und es mit C# kurz nachgebaut. Es geht ja ums Verfahren und nicht um den Code an sich

Code:

class Point
{
    public decimal X, Y;
    public override string ToString()
    {
        return string.Format("[{0:N2}, {1:N2}]" , X,Y);
    }
}

class PointList
{
    public decimal Eps = (decimal) 0.1;
    private readonly List<Point> items=new List<Point>();

    public List<Point> Items
    {
         get { return this.items; }
    }

    int Compare(Decimal a, Decimal b)
    {
        if (a + Eps < b)
            return -1;
        
        if (a > b + Eps)
            return +1;
        return 0;
    }
 
    int Compare(Point p1, Point p2)
    {
        int result = Compare(p1.X, p2.X);
        if (result == 0)
            result = Compare(p1.Y, p2.Y);
        return result;
    }

    public void Add(decimal x, decimal y)
    {
        items.Add(new Point {X = x, Y = y});
    }

    public void RemoveDuplicates()
    {
        items.Sort(Compare);
        int n = 0;
            
        for (int i=1;i<items.Count;i++)
        {
            if (Compare(items[i], items[n]) != 0)
            {
                n++;
                items[n] = items[i];
            }
        }
        items.RemoveRange(n+1,items.Count-n-1);
    }
}

Kurz und knackig.