Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Delphi Move to Front Doppelt Verkettete Listen (https://www.delphipraxis.net/187851-move-front-doppelt-verkettete-listen.html)

Sequitar 8. Jan 2016 17:46

Move to Front Doppelt Verkettete Listen
 
Hallo,

ich habe zu testzwecken eine doppelt verkettete liste erstellt.
Diese Klasse hat einen nachfahren, <MTFList2>, bei dem aufgerufene elemente am Anfang eingefügt werden, um so den zugriff auf die letzten elemente zu beschleunigen.

Nun habe ich das Problem, dass für die MTFList2 beim aufruf des n.elements (function GetItem) ein speicherloch von 12 byte per item entsteht (da ich einen neuen pointer auf das element erstelle, dann das element an den anfang verschiebe, dann aber nicht mehr "dispose"n kann). Den restlichen code der klassen habe ich soweit auf speicherlöcher getestet. Dies ist bisher der einzige Fall, wo solche auftreten.

Welche andere Möglichkeit gibt es hier, das zu vermeiden.

Delphi-Quellcode:
  Procedure Tlistfield.Setprevious(Item: Plistfield);
  Begin
    If Fprev <> Item Then
      Begin
        Fprev := Item;
        If Item <> Nil Then
          Begin
            If Item^.Fnext = Nil Then
              Begin
                New(Item^.Fnext);
                Item^.Fnext^ := Self;
              End
            Else
              If Item^.Fnext^ <> Self Then
                Begin
                  Dispose(Item^.Fnext);
                  New(Item^.Fnext);
                  Item^.Fnext^ := Self;
                End;
          End;
      End;
  End;

  Destructor Tlinklist2.Destroy;
  Begin
    Clear;
    Act^.Free;
    Dispose(Act);
    Fst := Nil;
    Lst := Nil;
    Act := Nil;
    Tmp := Nil;
    Assert(Not(Assigned(Fst)));
    Assert(Not(Assigned(Lst)));
    Assert(Not(Assigned(Act)));
    Assert(Not(Assigned(Tmp)));
    Inherited;
  End;

  Procedure Tlinklist2.Add(Const Item: Plistfield);
  // am Ende anfügen. Das Ende ist durch einen separaten Pointer auf das zuletzt angehängte element //gekennzeichnet. Am anfang besteht die liste nur durch ein leeres sentinel-element.
  Begin
    New(Lst^.Fnext);
    Lst^.Next^ := Item^;
    Item^.Setprevious(Lst);
    Lst := Item;
    Inc(Fcount)
  End;

  Procedure Tlinklist2.Clear;
  Begin
    Act := Lst;
    While (Act <> Nil) And (Act <> Fst) Do
      Begin
        Deletelast;
        Act := Lst;
      End;
    Fcount := 0;
    Assert(Fst = Lst)
  End;

  Procedure Tlinklist2.Deletelast;
  Var
    Tmp: Ptr;
  Begin
    If Fcount > 0 Then
      Begin
        Tmp := Lst^.FPrev;
        Tmp^.Fnext^.Free;
        Dispose(Tmp^.Fnext);
        Tmp^.Fnext := Nil;
        Dispose(Lst);
        Lst := Tmp;
        Dec(Fcount);
      End
    Else
      Begin
        Fst^.Free;
        Dispose(Fst);
        Fst := Nil;
        Act := Fst;
        Fcount := 0;
      End;
  End;

   //Property Items[Const Index: Cardinal]: Plistfield Read Getitem; Default;

  Function Tlinklist2.Getitem(Const Index: Cardinal): Plistfield;
  Var
    I: Cardinal;
    Act: Ptr;
  Begin
    If (Index >= Fcount) { Or (Index < 0) } Then
      Raise ERangeError.Create('Index out of Range')
    Else
      Begin
        I := 1;
        Act := Fst^.Next;
        While (I <= Index) Do
          Begin
            Act := Act^.Fnext;
            Inc(I);
          End;
        Result := Act;
      End;
  End;

  Function Tmtflist2.Getitem(Const Index: Cardinal): Plistfield;
  Var
    Islast: Boolean;
    Item: Ptr;
  Var
    I: Cardinal;
    Act, Tmp: Ptr;
  Begin
    New(Result);
    Result^ := Inherited^; // rufe element auf
    Mtf(Result); // und setze an den anfang
  End;

  Procedure Tmtflist2.MTF(Item: Plistfield);
  Var
    Islast: Boolean;
  Begin
    Islast := Item^.Fnext = Nil;
    Try
      Tmp := Item;
      If Not Islast Then
        Begin
          Dispose(Item^.Fnext^.FPrev);
          Item^.Fnext^.FPrev := Item^.FPrev;
        End
      Else // islast
        Begin
          Lst := Item^.FPrev;
          Dispose(Lst^.Fnext);
        End;
      If Item^.Fprev <> Nil Then
        Item^.FPrev^.Fnext := Item^.Fnext;
    Finally
      Item^.FPrev := Nil;
      Item^.Fnext := Nil;
    End;
    If Fst^.Fnext <> Nil Then
      // Dispose(Target^.Fnext^.FPrev);
      Fst^.Fnext^.Setprevious(Item);
    // Dispose(Target^.Fnext);
    Item^.Setprevious(Fst);
  End;

Sequitar 9. Jan 2016 23:25

AW: Move to Front Doppelt Verkettete Listen
 
Update:
Memory Leak tritt nun nur noch auf, wenn das letzte element ausgewählt wird.

Neuer Code:
Delphi-Quellcode:
 Function Tmtflist2.Getitem(Const Index: Cardinal): Plistfield;
  Begin
    Tmp := Inherited;
    Mtf(Tmp);
    Result := Tmp;
  End;

  Procedure Tmtflist2.MTF(Item: Plistfield);
  // leaks 12 byte if item is last
  Var
    Islast: Boolean;
  Begin
    Islast := Item^.Fnext = Nil;
    Try
      Tmp := Item;
      If Not Islast Then
        Begin
          Dispose(Item^.Fnext^.FPrev);
          Item^.Fnext^.FPrev := Item^.FPrev;
        End
      Else // islast: error
        Begin
          Lst := Item^.FPrev;
          Lst^.Fnext := Nil;
        End;
      If Item^.Fprev <> Nil Then
        Item^.FPrev^.Fnext := Item^.Fnext;
    Finally
      Item^.FPrev := Nil;
      Item^.Fnext := Nil;
    End;
    If Fst^.Fnext <> Nil Then
      Fst^.Fnext^.Setprevious(Item);
    Item^.Setprevious(Fst);
  End;

Klaus01 10. Jan 2016 08:55

AW: Move to Front Doppelt Verkettete Listen
 
.. ein Schuss ins Blaue
Delphi-Quellcode:
else // islast: error
  begin
    Lst := Item^.FPrev;
    Dispose(Lst^.Fnext);
    Lst^.Fnext := Nil;
  end;
Grüße
Klaus

Sequitar 11. Jan 2016 11:44

AW: Move to Front Doppelt Verkettete Listen
 
Danke Klaus, das hat geholfen.
Hatte die Freigabe übersehen.

Kann man da vielleicht auch noch was ändern, um die Geschwindigkeit zu erhöhen? Auf den Teil soll später sehr häufig für Suchen zugegriffen werden (zb. Chained Hashtable).
Oder eignet sich die Herangehensweise hier nicht? Gibt es Alternativen? Ich hatte z.b an Suchbäume gedacht...


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

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