aus einer Liste Einträge in eine andere Liste verschieben

[Bjoerk]

Ich möchte aus einer Liste Einträge in eine andere Liste übertragen und gleichzeitig aus der alten Liste raus löschen. Das tue ich deshalb weil der einzige in der alten Liste verbleibende Eintrag ein wichtiges Ergebnis ist. Bis jetzt ist es mir nicht gelungen.. :oops:

Delphi-Quellcode:

procedure TPolygonTriangles.Flip;
var
  k1, k2, I, J: integer;
  SCur, SNew: double;
  ACur, BCur, ANew, BNew: TFLoatPoints;
begin
  ACur := TFLoatPoints.Create;
  BCur := TFLoatPoints.Create;
  ANew := TFLoatPoints.Create;
  BNew := TFLoatPoints.Create;
  try
    for k1 := 0 to Count - 2 do
      for k2 := k1 + 1 to Count - 1 do
      begin
        ACur.Clear;
        BCur.Clear;
        ANew.Clear;
        BNew.Clear;
        ACur.Add(Item[k1].A);
        ACur.Add(Item[k1].B);
        ACur.Add(Item[k1].C);
        BCur.Add(Item[k2].A);
        BCur.Add(Item[k2].B);
        BCur.Add(Item[k2].C);
        I := 0;
        J := 0;
        while I < ACur.Count  do
        begin
          while J < ACur.Count  do
          begin
            if Util_SameFloatPoint(ACur[I], BCur[J]) then
            begin
              // ShowMessage(Format('ACur(I) %.4f %.4f', [ACur[I].X, ACur[I].Y]));
              // ShowMessage(Format('BCur(J) %.4f %.4f', [BCur[J].X, BCur[J].Y]));
              ANew.Add(ACur[I]);
              BNew.Add(BCur[J]);
              // ShowMessage('IndexOf ACur ' + IntToStr(ACur.IndexOf(ACur[I])));
              // ShowMessage('IndexOf BCur ' + IntToStr(BCur.IndexOf(BCur[J])));
              ACur.Del(ACur.IndexOf(ACur[I]));
              BCur.Del(BCur.IndexOf(BCur[J]));
              Dec(I); // *** Kann nicht stimmen, aber wie ???
              Dec(J);
            end;
            Inc(J);
          end;
          Inc(I);
        end;
        if (ANew.Count = 2) then // Adjacent;
        begin
          SCur := Util_FloatPointDistance(ANew[0], ANew[1]);
          SNew := Util_FloatPointDistance(ACur[0], BCur[0]);
          if SCur / SNew > 1.5 then
          begin
            Item[k1].A := ANew[0];
            Item[k1].B := ACur[0];
            Item[k1].C := BCur[0];
            Item[k2].A := ACur[0];
            Item[k2].B := ANew[1];
            Item[k2].C := BCur[0];
          end;
        end;
      end;
  finally
    ACur.Free;
    BCur.Free;
    ANew.Free;
    BNew.Free;
  end;
end;

[Dejan Vu]

Delphi-Quellcode:

For i:= list.count-1 downto 0 do
  if SatisfiesMoveCondition(List.Item[i]) then begin
    NewList.Append(List.Item[i]);
    List.RemoveItem(i);
  end

Das mal so -wie immer mit jugendlichem Leichtsinn- als generelles Pattern, wie man z.B. aus einer Liste während des Durchlaufens Elemente entfernen kann. Trick ist hier, das man rückwärts läuft. Würde man vorwärts laufen, würde man beim Löschen das jeweils nächste Element überspringen.

Wie ich sehe, läufst Du vorwärts durch. ;-) Du hast zwar bemerkt, das Du ein Element überspringen wirst, aber scheinbar klappt das nicht. Genau hab ich mir das aber jetzt angeschaut....

Noch ein Tipp: Alles, was ausgelagert werden kann, auslagern. Damit meine ich, in eine kleine separate Prozedur packen. Delphi macht das mit den Refactoring-Werkzeugen von ganz alleine.

PS: Was genau das Problem ist, wäre noch lustig, zu wissen.

[-=ZGD=-]

Downto..

Edit..Oh, da war einer schneller..

[DeddyH]

BTW: 4 Instanzierungen vor dem try sind gewagt, das kann zu Speicherlecks führen.

[Bjoerk]

Das Ding ist, daß sowohl i als auch j gleichzeitig verändert werden. Da hilft auch kein downto (wie sonst üblich).

[Jumpy]

Nur mal so gefragt:

Ist

Delphi-Quellcode:

BCur.Del(BCur.IndexOf(BCur[J]));

nicht einfach

Delphi-Quellcode:

BCur.Del(J)

?


Generell kann man sich in dem Fall vllt. die zu löschenden Indizes in einer Liste/Array merken und dann nachher löschen, z.B. in einer eigenen Prozedur DeleteFromList(indexe : array of integer) oder sowas.

[Bjoerk]

Weiß nicht mehr, würde sagen ja. Habs jetzt auch "anständig" gemacht, da sieht die Flip auch schon wesentlich gemütlicher aus. Flip bedeutet Kantenflip bei benachbarten Dreiecken, die zusammen eine Raute bilden. Da werden die beiden Dreiecke in der anderen Möglichkeit diese Raute zu bilden angeordnet, falls ein gewisses Seitenverhältnis überschritten ist.

Delphi-Quellcode:

function TPolygonTriangle.IndexOf(const Value: TFLoatPoint): integer;
begin
  Result := -1;
  if Util_SameFloatPoint(Value, A) then
    Result := 0
  else
    if Util_SameFloatPoint(Value, B) then
      Result := 1
    else
      if Util_SameFloatPoint(Value, C) then
        Result := 2;
end;

function TPolygonTriangle.Compare(const Value: TPolygonTriangle): boolean;
begin
  Result := (IndexOf(Value.A) > 0) and (IndexOf(Value.B) > 0)
    and (IndexOf(Value.C) > 0)
end;

function TPolygonTriangle.Adjacent(const Value: TPolygonTriangle): boolean;
begin
  Result := (IndexOf(Value.A) > 0) and (IndexOf(Value.B) > 0)
    or (IndexOf(Value.A) > 0) and (IndexOf(Value.C) > 0)
    or (IndexOf(Value.B) > 0) and (IndexOf(Value.C) > 0);
end;

function TPolygonTriangle.FirstAdjacent(const Value: TPolygonTriangle): TFloatPoint;
var
  I, J: integer;
  P1, P2: array[0..2] of TFloatPoint;
begin
  // Self and Value müssen Adjacent Items sein;
  Result.Clear;
  P1[0] := A;
  P1[1] := B;
  P1[2] := C;
  P2[0] := Value.A;
  P2[1] := Value.B;
  P2[2] := Value.C;
  for I := 0 to 2 do
    for J := 0 to 2 do
      if Util_SameFloatPoint(P1[I], P2[J]) then
      begin
        Result := P1[I];
        Exit;
      end;
end;

function TPolygonTriangle.SecondAdjacent(const Value: TPolygonTriangle): TFLoatPoint;
var
  I, J: integer;
  P1, P2: array[0..2] of TFloatPoint;
begin
  // Self and Value müssen Adjacent Items sein;
  Result.Clear;
  P1[0] := A;
  P1[1] := B;
  P1[2] := C;
  P2[0] := Value.A;
  P2[1] := Value.B;
  P2[2] := Value.C;
  for I := 0 to 2 do
    for J := 0 to 2 do
      if Util_SameFloatPoint(P1[I], P2[J]) then
        Result := P1[I];
end;

function TPolygonTriangle.NotAdjacent(const Value: TPolygonTriangle): TFLoatPoint;
var
  P1, P2: TFloatPoint;
begin
  // Self and Value müssen Adjacent Items sein;
  P1 := FirstAdjacent(Value);
  P2 := SecondAdjacent(Value);
  if (not Util_SameFloatPoint(P1, A)) and (not Util_SameFloatPoint(P2, A)) then
    Result := A
  else
    if (not Util_SameFloatPoint(P1, B)) and (not Util_SameFloatPoint(P2, B)) then
      Result := B
    else
      Result := C;
end;


// ..

procedure TPolygonTriangles.Flip;
var
  I, J: integer;
  SCur, SNew: double;
  A1, A2, A3, B3: TFLoatPoint;
begin
  for I := 0 to Count - 2 do
    for J := I + 1 to Count - 1 do
      if Item[I].Adjacent(Item[J]) then
      begin
        A1 := Item[I].FirstAdjacent(Item[J]);
        A2 := Item[I].SecondAdjacent(Item[J]);
        A3 := Item[I].NotAdjacent(Item[J]);
        B3 := Item[J].NotAdjacent(Item[I]);
        SCur := Util_FloatPointDistance(A1, A2);
        SNew := Util_FloatPointDistance(A3, B3);
        if SCur / SNew > 1.5 then
        begin
          Item[I].A := A1;
          Item[I].B := A3;
          Item[I].C := B3;
          Item[J].A := A3;
          Item[J].B := A2;
          Item[J].C := B3;
        end;
      end;
end;

[pelzig]

Zitat: "die zusammen eine Raute bilden"

Du entwickelst also für das Kanzleramt/Murksel?

SCNR als ich "Raute" lesen musste :cry:

Tschulldigung!

[Aviator]

Zitat:

Zitat von DeddyH (Beitrag 1272237)

BTW: 4 Instanzierungen vor dem try sind gewagt, das kann zu Speicherlecks führen.

Vielleicht etwas blöde Frage, aber warum? Nicht das ich es jetzt auch machen würde, aber es interessiert mich nur einmal.

[DeddyH]

Hier habe ich neulich einmal ein paar Beispiele skizziert: http://forum.delphi-treff.de/index.p...-verschachteln