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

[Sir Rufo]

Damit es auch hier steht

Delphi-Quellcode:

procedure fooOne;
var
  bar : TBar;
begin
  bar := TBar.Create;
  try
    // work on bar
  finally
    bar.Free;
  end;
end;

// aber nicht so

procedure fooNleaks;
var
  bar1 : TBar1;
  bar2 : TBar2;
begin
  bar1 := TBar1.Create;
  // wenn jetzt eine Exception ausgelöst wird, dann wird bar1 niemals entfernt!
  bar2 := TBar2.Create;
  try
    // work on bars
  finally
    bar1.Free;
    bar2.Free;
  end;
end;

// darum so

procedure fooNsafe;
var
  bar1 : TBar1;
  bar2 : TBar2;
begin
  // lokale Variablen sind NICHT initialisiert, darum auf NIL setzen!
  bar1 := nil;
  bar2 := nil;
  try
    bar1 := TBar1.Create;
    // wenn jetzt eine Exception ausgelöst wird, dann wird bar1 korrekt entfernt!
    bar2 := TBar2.Create;
    // work on bars
  finally
    bar1.Free;
    bar2.Free;
  end;
end;

[DeddyH]

Und damit es auch komplett hier steht, die Alternative:

Delphi-Quellcode:

procedure fooNsafe;
var
  bar1 : TBar1;
  bar2 : TBar2;
begin
  //Verschachteln der Ressourcenschutzblöcke
  bar1 := TBar1.Create;
  try
    bar2 := TBar2.Create;
    try
      // work on bars
    finally
      bar2.Free;
    end;
  finally
    bar1.Free;    
  end;
end;

[Sir Rufo]

@DeddyH

Wer macht denn sowas? ;)

Ja geht auch, aber mir ist das zu verschachtelt und zuviel Tipparbeit ... nix für faule Leute wie mich :stupid:

[DeddyH]

Wenn es nur 2 Blöcke sind, mache ich das schon. Sollten es mehr sein, tut die Methode wahrscheinlich sowieso schon zu viel, ist also ein Fall für die Auslagerung ;)

[Aviator]

Danke für die Info. So habe ich das zwar noch nicht gesehen, aber bei mir kommt es nicht so oft vor, dass mehrere Creates hintereinander ausgeführt werden.

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1272352)

@
Ja geht auch, aber mir ist das zu verschachtelt und zuviel Tipparbeit ... nix für faule Leute wie mich :stupid:

hmm...

Delphi-Quellcode:

var
  IBar1 : TBar1Intf;
  IBar2 : TBar2Intf;
begin
  IBar1 := TBar1Impl.Create;
  IBar2 := TBar2Impl.Create;
  // work on iBar's
end;

[Bjoerk]

TBar1Intf, TBar2Intf, TBar1Impl, TBar2Impl: Qu'est-ce que c'est? :gruebel:

[Sir Rufo]

Bei einem Interface mit Referenzzählung braucht man auch nicht freigeben.

Und benennen kann man die, wie man will, ein I statt einem T ist ratsam aber nicht Pflicht

[DeddyH]

Zitat:

Zitat von Sir Rufo (Beitrag 1272514)

Bei einem Interface mit Referenzzählung braucht man auch nicht freigeben.

Stimmt, aber wenn die Implementationen von TInterfacedPersistent abstammen, ist der gezeigte Code wieder für's Gesäß. Außerdem finde ich es fragwürdig, Interfaces als Ersatz für Garbage Collection zu benutzen.

[Bjoerk]

Ok. Mit interfaces arbeite ich eh nie (keinen Plan). Würde mal sagen, bei Klassen hängt's auch davon ab, was im constructor so passiert. Ein TObject.Create wird wohl nicht wahnsinnig viele Exceptions werfen? Dennoch, ich stimme #14 voll und ganz zu und so hatte ich's ja auch gemacht.

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1272514)

ein I statt einem T ist ratsam aber nicht Pflicht

Gebe ich Dir recht, aber wie nennst Du dann die Variable?

Beispiel:

Delphi-Quellcode:

type 
   IFoo = Interface...
var
  Foo : IFoo;

oder

Delphi-Quellcode:

var
  IFoo : IFooFace; // :-)

Zitat:

Zitat von DeddyH (Beitrag 1272519)

Außerdem finde ich es fragwürdig, Interfaces als Ersatz für Garbage Collection zu benutzen.

Nöö ganz im Gegenteil.
Solange es noch keine Referenzzählung für Win32 gibt, ist dass DIE Möglichkeit den gleichen Code auf allen Plattformen zu benutzen...

Es sei den du willst wieder den ewigen try try try try finally finally finally finally Baum haben.
Und dann immer die .Free die auf der Mobilen Seite ignoriert werden.
Da man dann doch an bestimmten stellen ein .disposeof benötigt kommt man zu schnell durcheinander und der Code wird unleserlich.

Mavarik

[DeddyH]

Du weißt nicht, wie man so eine Variable benennen sollte und sprichst dann von unleserlichem Code? Und wie schon angedeutet: nicht jede Klasse, die ein Interface implementiert, ist auch automatisch referenzgezählt. Gut, wenn das ausschließlich eigene Klassen sind, kann man dafür sorgen, aber sind sie das immer? Im Übrigen: wenn man einen try-finally-"Baum" im Code hat, macht die Methode höchstwahrscheinlich schon zu viel, da heißt es dann Aufteilen (hatte ich aber auch schon geschrieben).