Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Doppelte Dreiecke in einem Array finden.... ? (https://www.delphipraxis.net/94347-doppelte-dreiecke-einem-array-finden.html)

turboPASCAL 20. Jun 2007 10:55


Doppelte Dreiecke in einem Array finden.... ?
 
Hi,

Ich bräuchte mal ne kleine Hilfe, es geht darum das ich Dreieckskoordinaten in einem
Array auffinden möchte.
Die Dreieckskoordinaten liegen wiefolgt vor:

Punkt 1: x1,y1,z1 Punkt 2: x2,y2,z2 Punkt 3: x3,y3,z3

Diese Koordinaten definieren in meinem Programm ein Dreieck in OpenGl. Leider sind die
Rohdaten so das es vorkommen kann das diese Dreiecke doppelt oder dreifach vorhanden
sein können. Diese möchte ich herausfiltern.

zB.:

Code:
ein vorhandenes Dreieck: Punkt 1: x1,y1,z1 Punkt 2: x2,y2,z2 Punkt 3: x3,y3,z3
ein doppeltes Dreieck:   Punkt 1: x2,y2,z2 Punkt 2: x2,y2,z2 Punkt 3: x1,y1,z1

So werden die Daten aus einer Datei gelesen:
Delphi-Quellcode:
type
  TVertex = array [0..2] of Single;
  TFace = array [0..2] of TVertex;
  T3DObject = array of TFace;

var
  m3DObject: T3DObject;
  FaceCount: Integer;

procedure TForm1.btnLoadFileClick(Sender: TObject);
var
  F: TextFile;
begin
  FaceCount := 0;
  // ...

  AssignFile(F, m3DOjectFileName);
  {$I-}
  reset(F);
  if IOResult = 0 then
  begin
    while not eof(F) do
    begin
      inc(FaceCount);
      SetLength(m3DObject, FaceCount + 1);

      readln(F, m3DObject[FaceCount, 0, 0],
                m3DObject[FaceCount, 0, 1],
                m3DObject[FaceCount, 0, 2],

                m3DObject[FaceCount, 1, 0],
                m3DObject[FaceCount, 1, 1],
                m3DObject[FaceCount, 1, 2],

                m3DObject[FaceCount, 2, 0],
                m3DObject[FaceCount, 2, 1],
                m3DObject[FaceCount, 2, 2]);

      if FaceCount mod 100 = 0 then
      begin
        Application.ProcessMessages;
        DebugStrOut(TRUE, format('Read Line: %d', [FaceCount]), clGray);
      end;
    end;
  end;
  CloseFile(F);
  {$I+}
  // ...
end;
Und nun das Problemchen das finden der "Doppelganger":

Delphi-Quellcode:
procedure TForm1.btnChkOfDuplicateClick(Sender: TObject);
var
  Find: TFace;
  i, n: integer;
begin
  DebugStrOut(TRUE, 'Begin Check of Duplicate', clGreen, [fsBold]);

  for n:=0 to High(m3DObject) do
  begin
    Find := m3DObject[n];
    for i:=0 to High(m3DObject) do
    begin
      if n <> i then
        if (
           (Find[0, 0] = m3DObject[i, 0, 0]) and
           (Find[0, 1] = m3DObject[i, 0, 1]) and
           (Find[0, 2] = m3DObject[i, 0, 2]) and

           (Find[1, 0] = m3DObject[i, 1, 0]) and
           (Find[1, 1] = m3DObject[i, 1, 1]) and
           (Find[1, 2] = m3DObject[i, 1, 2]) and

           (Find[2, 0] = m3DObject[i, 2, 0]) and
           (Find[2, 1] = m3DObject[i, 2, 1]) and
           (Find[2, 2] = m3DObject[i, 2, 2])
                                           ) or
           (
           (Find[0, 2] = m3DObject[i, 0, 0]) and
           (Find[0, 1] = m3DObject[i, 0, 1]) and
           (Find[0, 0] = m3DObject[i, 0, 2]) and
           //...
                                           ) then
          DebugStrOut(TRUE, '...found Duplicate @ ' + inttostr(i));
    end;
  end;

  DebugStrOut(TRUE, 'DONE: Check of Duplicate.', clGreen, [fsBold]);
end;
gibt es eine Möglichkeit das ich mir das getippe der Folgenden Möglichkeiten erspare ?

dizzy 20. Jun 2007 11:50

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Du könntest beim Einlesen die Vertices so drehen, dass immer der z.B. betragsmäßig kleinste Vektor im 0-ten Element steht. Damit stellst du sicher, dass doppelte Dreiecke gleiche Punktverteilung im Array haben, und durch das "drehen" veränderst du die Normalen nicht.
Ist dann zwar etwas Aufwand beim einlesen, aber dann könntest du die Dreiecke sogar nach der Länge des 0-ten Vektors sortiert in eine Liste speichern, und binäre Suche verwenden um doppelte zu finden! Das verringert die Suchzeit im Best-Case von O(n) auf O(n*log(n)) als kleine Dreingabe.

TheAn00bis 20. Jun 2007 11:51

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Du könntest vorher einmal alle Daten durchlaufen und die Dreiecke immer in die selbe Form bringen, z.B. Dreieck[Punkt links, Punkt mitte, Punkt rechts].

Ansonsten glaub ich nicht, dass sich die Überprüfung einfacher gestalten lässt. Aber wo kommen die Daten denn her?


Edit: Ist wohl das gleiche, wie Dizzy vorschlägt.

turboPASCAL 20. Jun 2007 12:06

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Die Normalen sin uninteressant da es (noch) keine gibt. ;)
Die Daten kommen von einem "Verhusten" 3D Modell welches ich gerade biegen soll/möchte.
es sind rund 20000 Einträge pro Dreieck.

Zitat:

Du könntest beim Einlesen die Vertices so drehen, dass immer der z.B. betragsmäßig kleinste Vektor im 0-ten Element steht.
Dann müsste ich ja dort diese Vectoren vergleichen. Also getippe 3 * 3 if abfragen... ?!

volkerw 20. Jun 2007 13:06

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Hallo,
sortieren und Duplikate finden kann man doch auch mit StringListen, dazu fiel mir so was ein (natürlich nicht getestet):
Delphi-Quellcode:
procedure TForm1.btnChkOfDuplicateClick(Sender: TObject);
var
  Find: TFace;
  i, j, n: integer;
  SL1Dreieck, SLnDreiecke : TStringList;
begin
  SL1Dreieck := TStringList.Create;
  SL1Dreieck.Sorted := True;
  SLnDreiecke := TStringList.Create;
  SLnDreiecke.Sorted := False;
  SLnDreiecke.Duplicates := dupError;
 
  DebugStrOut(TRUE, 'Begin Check of Duplicate', clGreen, [fsBold]);

  for i:=0 to High(m3DObject) do
  begin
    if n <> i then
      begin
        SL1Dreieck.Clear;
        for j := 0 to 2 do // 1 Dreieck , 3 Punkte
          SL1Dreieck.Add(IntToStr(m3DObject[i, j, 0]) +
                         IntToStr(m3DObject[i, j, 1]) +
                         IntToStr(m3DObject[i, j, 2]));
        // Jetzt haben wir: X0Y0Z0, X1Y1Z1, X2Y2Z2 -> sortiert
        try
          SLnDreiecke.Add(SL1Dreieck.Strings[0] + SL1Dreieck.Strings[1] +
                          SL1Dreieck.Strings[2]);
         // Jetzt haben wir: X0Y0Z0X1Y1Z1X2Y2Z2
         // Ein Duplikat sollte jetzt eine EStringListError-Exception erzeugen.
        except
          DebugStrOut(TRUE, '...found Duplicate @ ' + inttostr(i));
        end;
      end;
  end;
  SL1Dreieck.Free;
  SLnDreiecke.Free;
  DebugStrOut(TRUE, 'DONE: Check of Duplicate.', clGreen, [fsBold]);
end;
Performancemäßig wahrscheinlich nicht der Renner, aber simpel.

kalmi01 20. Jun 2007 13:22

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Hi,

ich würde die Koordinatensumme eines Dreiecks als Vorentscheidung hernehmen.

X = (X1 + X2 + X3)
Y = (Y1 + Y2 + Y3)

Dann brauchst Du nur noch auf Gleichheit von X'en und Y'en prüfen.
Nur wenn 2 X'e und 2 Y'e gleich sind, musst Du die drei Eckpunkte prüfen.

turboPASCAL 21. Jun 2007 07:35

Re: Doppelte Dreiecke in einem Array finden.... ?
 
@volkerw,

hm, das wird ja so nix. L1Dreieck.Add(IntToStr(m3DObject[i, j, 0]) ist ein Array
und kein Integer. ;)

@kalmi01, den Gedanken bzw. so Ähnlich hatte ich auch. Bin mir aber nicht sicher ob
das so wird...

volkerw 21. Jun 2007 08:13

Re: Doppelte Dreiecke in einem Array finden.... ?
 
@turboPascal,
wenn m3DObject ein dreidimensionales Array aus Singlewerten ist, dann stellt m3DObject[i, j, 0] genau einen Wert dar,
oder sehe ich das falsch ?

turboPASCAL 22. Jun 2007 09:00

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Zitat:

Zitat von volkerw
wenn m3DObject ein dreidimensionales Array aus Singlewerten ist, dann stellt m3DObject[i, j, 0] genau einen Wert dar,
oder sehe ich das falsch ?

Ja. ;)

Delphi-Quellcode:
type
  TVertex = array [0..2] of Single;
  TFace = array [0..2] of TVertex;
  T3DObject = array of TFace;

var
  m3DObject: T3DObject;
es konnte auch so aussehen:

Delphi-Quellcode:
  m3DObject: array of record // Points for Faces
                        VertexA: Record // Points A of Faces
                                   X, Y, Z: Single;
                                 end;
                        VertexB: Record // Points B of Faces
                                   X, Y, Z: Single;
                                 end;
                        VertexC: Record // Points C of Faces
                                   X, Y, Z: Single;
                                 end;
                      end;
m3DObject gibt also den Record "Points for Faces" zurück. Im oberen Code ist es halt ein
Eindimensionales Array von 0..2 für drei Arrays mit je drei Singlewerten.


Mit Corpsman Hilfe schaut das ganze nun so aus:

Delphi-Quellcode:
procedure TForm1.btnChkOfDuplicateClick(Sender: TObject);
const
  Toleranz = 0.00001;

  function Tollgleich(v1, v2: single): Boolean;
  begin
    result := abs(v1 - v2) <= Toleranz;
  end;

  function IsSame(v1: TFace; v2: Tface): boolean;
  begin
    result := false;
    if (tollgleich(v1[0, 0], v2[0, 0])) and (tollgleich(v1[0, 1], v2[0, 1]))
      and (tollgleich(v1[0, 2], v2[0, 2])) and (tollgleich(v1[1, 0], v2[1, 0]))
      and (tollgleich(v1[1, 1], v2[1, 1])) and (tollgleich(v1[1, 2], v2[1, 2]))
      and (tollgleich(v1[2, 0], v2[2, 0])) and (tollgleich(v1[2, 1], v2[2, 1]))
      and (tollgleich(v1[2, 2], v2[2, 2])) then Result := True;
  end;

  function RotFace(v1: TFace): Tface;
  begin
    result[0] := v1[1];
    result[1] := v1[2];
    result[2] := v1[0];
  end;
 
  function MirrowFace(v1: Tface): Tface;
  begin
    result[0] := v1[2];
    result[1] := v1[1];
    result[2] := v1[0];
  end;

var
  Aktuell, Gerade: TFace;
  i, n, d: integer;
begin
  StrOut(TRUE, 'Begin Check of Duplicate', clGreen, [fsBold]);

  finished := FALSE;
  btnCancel.Enabled := TRUE;
  ProgressBar1.Visible := TRUE;
  ProgressBar1.Position := 0;
  ProgressBar1.Max := High(m3DObject);
  d := 0;
 
  for n := 0 to High(m3DObject) do
  begin
    if finished then Break;
    Aktuell := m3DObject[n];
    for i := n + 1 to High(m3DObject) do
    begin
      if finished then Break;
      if i mod 100 = 0 then Application.ProcessMessages;
      ProgressBar1.Position := n;
      gerade := m3DObject[i]; // Die Bewegungsgruppe des Dreiecks besagt 6 Mögliche stellungen !!
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall1');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall2');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall3');
      end;
      Gerade := RotFace(gerade);
      Gerade := MirrowFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall4');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall5');
      end;
      Gerade := RotFace(gerade);
      if IsSame(Aktuell, Gerade) then
      begin
        inc(d);
        DBGOut.lines.add(inttostr(n) + ' ist Gleich wie ' + inttostr(i) + ' Fall6');
      end;
    end;
  end;

  ProgressBar1.Visible := FALSE;
  ProgressBar1.Position := 0;
  btnCancel.Enabled := FALSE;

  if not finished
    then StrOut(TRUE, format('DONE: Check of Duplicate. (%d)', [d]), clGreen, [fsBold])
    else StrOut(TRUE, 'CANCEL: Check of Duplicate.', clRed, [fsBold]);
end;

volkerw 22. Jun 2007 10:41

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Einspruch, m3DObject[i, j, 1] sellt einen Single-Wert dar !
Habe es sogar ausprobiert, nur 3 Änderungen an meinem Vorschlag sind nötig:
1. aus IntToStr wird FloatToStr (klar, ist ja Single)
2. SLnDreiecke.Sorted := True; (sonst kein Error bei Duplikat)
3. Die For-Schleife in btnChkOfDuplicateClick muß bei 1 beginnen.

Hier der Input, 3 Dreiecke, von denen die ersten 2 identisch sind, nur 2 Punkte sind vertauscht:
0.0 0.0 0.0 1.5 2.5 3.5 4.0 5.0 6.0
0.0 0.0 0.0 4.0 5.0 6.0 1.5 2.5 3.5
0 9 8 5 5 5 11 12 13.5

Und der Output (habe einige Zwischenergebnisse und DebugStrOut in ein Memo geschrieben) sieht wie erwartet aus:
Read Line: 1
Read Line: 2
Read Line: 3
Begin Check of Duplicate

Dreieck 1
P 0 : 000
P 1 : 1,52,53,5
P 2 : 456
Punkte sortiert : 0001,52,53,5456

Dreieck 2
P 0 : 000
P 1 : 456
P 2 : 1,52,53,5
Punkte sortiert : 0001,52,53,5456
...found Duplicate @ 2

Dreieck 3
P 0 : 098
P 1 : 555
P 2 : 111213,5
Punkte sortiert : 098111213,5555
DONE: Check of Duplicate.

Funktioniert, wie man sieht (und das waren genau turboPASCALs Routinen mit den von mir beschriebenen Änderungen, nichts dazugepfuscht) .
Gruß Volker

dizzy 22. Jun 2007 11:12

Re: Doppelte Dreiecke in einem Array finden.... ?
 
Zitat:

Zitat von turboPASCAL
Die Normalen sin uninteressant da es (noch) keine gibt. ;)

Jain, OpenGL z.B. erzeugt, wenn nicht anders angegeben, implizit Normalen senkrecht zu der Ebene die das Dreieck beschreibt. Wie sie orientiert ist, ist von der Reihenfolge der Punkte abhängig. Ich glaub es ist so, dass wenn du das Dreieck plan vor dir siehst, und die Punkte gegen den Uhrzeigersinn beschrieben sind, zeigt die Normale auf dich.
Das ist in sofern interessant, als dass in vielen Realtimeanwendungen Backfaceculling betrieben wird, also Dreiecke, deren Normalen nach "hinten" in den Bildschirk rein zeigen, werden nicht gezeichnet, da sie bei geschlossenen Objekten eh immer verdeckt wären.
Vertauscht du die Reihenfolgen nun bei manchen, tauchen u.U. Löcher in der Darstellung auf. Es gilt zudem als guter Stil für alle Faces die gleiche "Vertex-Order" zugrunde zu legen.

Zitat:

Zitat von turboPASCAL
Zitat:

Du könntest beim Einlesen die Vertices so drehen, dass immer der z.B. betragsmäßig kleinste Vektor im 0-ten Element steht.
Dann müsste ich ja dort diese Vectoren vergleichen. Also getippe 3 * 3 if abfragen... ?!

Nein, du würdest drei mal einen Vektorbetrag errechnen, dann 1 bis 2 mal die Arrayelemente verschieben, und müsstest zum einsortieren nur noch einen Vergleich (0-tes Element) durchführen.
Bei binärer Suche kommt hinzu, dass du extrem weniger Vergleiche zum einsortieren brauchst, und du hast anschließend schön alle Dreiecke hintereinander stehen, bei denen der kürzeste Vektor (vom Urprung gesehen) gleich ist. Damit musst du nur noch diese kleine Gruppe untereinander elementweise vergleichen um doppelte auszumachen.
Bei dem jetzigen Vorgehen prüfst du jedes Dreieck gegen jedes andere. Der Aufwand ist O(n²), bestenfalls, wenn man es geschickt löst, O((n*(n+1))/2).
Das binäre einsortieren hat eine worst-case Laufzeit von O(log(n)), und die gruppenweise Vergleiche wieder O(n²) bzw. O((n*(n+1))/2), jedoch mit einem weiiiiiit aus kleinen n!

Es gibt hierbei noch 2 Spielarten:
1) Direkt beim Einsortieren in die Liste Nachbarn mit gleichem 0-ten Element auf Gleichheit prüfen, und bei Fund den Eintrag erst garnicht machen, oder
2) Erst die Liste komplett aufbauen, und dann die Vergleiche machen.

Ersteres ist natürlich nochmal etwas schneller, da man die Liste von vorne herein möglichst klein hält, was dem Suchen beim Einsortieren zugute kommt, sowie ein zweites Durchgehen der gesamten Liste vermeidet.
Die einzige Optimierung, die mir dann noch einfiele, wäre statt binärer Suche zum Eintragen die Interpolationssuche. Aber das ist dann wirklich nur noch Finetunig. Die anderen Dinge jedoch sind echte Booster!


Zum Thema Strings: :shock: Wenn ich doch schon wunderbare Zahlenwerte habe, warum diese dann als Strings behandeln!? Zusammen mit den Konvertierungen und aufwendigen Vergleichen dürfte die Laufzeit damit unheimlich steigen, und so wirklich Speicherfreundlich ist das auch nicht! Zumal wir hier von einem 3D-Modell reden, welche gerne mal mehrere Tausend Faces haben, evtl. Millionen. DA mit Strings dranzugehen ist, nett ausgedrückt, unglaublich ungeeignet ;)


Gruss,
Fabian


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:53 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz