Doppelte Dreiecke in einem Array finden.... ?

[turboPASCAL]

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]

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]

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]

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]

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]

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]

@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]

@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]

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]

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