Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-devel / 2008-08

TAVLTree(avl_tree.pp) thread safety : second proposition

18 messages · 7 people · –

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

Inoussa OUEDRAOGO

Second proposition :

Another proposition is to introduce a base avl class say TBaseAVLTree that defines two abstract virtual methods "NewNode()" and "FreeNode()" and then define :
- TAVLTree : that _do not_ use a node mem manager, then thread safe.
- TAVLManagedTree that uses a node mem manager provided in the constructor. The developer using this one is _aware_ of the thread safety issue and can then provide a thread safe node mem manager for an instance exposed to more than one thread while using the default not thread safe node mem manager for a thread local instance.

For the record, even if each thread has a non-thread-safe node mem manager the issue remains : ThreadA create a avl and populate it. ThreadB delete some nodes of that avl. The deleted nodes have been created using ThreadA's node mem manager while collected by ThreadB's node mem manager. ThreadA and ThreadB could be using different node mem manager implementations.

TBaseAVLTree = class
...
protected
 function NewNode() : TAVLTreeNode;virtual;abstract;
 procedure FreeNode(ANode : TAVLTree);virtual;abstract;
...
end;
TAVLTree = class(TBaseAVLTree)
protected
 function NewNode() : TAVLTreeNode;override;
 { implemented as
   begin
     Result:=TAVLTreeNode.Create();
   end;}
 procedure FreeNode(ANode : TAVLTree);override;
 { implemented as
   begin
     if ( ANode  nil ) then
       ANode.Free();
   end;}
end;
TAVLManagedTree = class(TBaseAVLTree)
private
 FNodeMemManager : TAVLTreeNodeMemManager;
protected
 // these implementations use FNodeMemManager
 function NewNode() : TAVLTreeNode;override;
 procedure FreeNode(ANode : TAVLTree);override;
public
 constructor Create(OnCompareMethod: TListSortCompare;
ANodeMemManager : TAVLTreeNodeMemManager);
end;
Inoussa O.

Reply by email

Micha Nelissen
to Inoussa OUEDRAOGO
Inoussa OUEDRAOGO wrote
- TAVLManagedTree that uses a node mem manager provided in the constructor. The developer using this one is _aware_ of the thread safety issue and can then provide a thread safe node mem manager for an instance exposed

What is exactly the add-on value for the node mem manager?

Micha

Reply by email

Inoussa OUEDRAOGO
to Micha Nelissen

2008/8/7 Micha Nelissen :

Show quoted text 9 lines
Inoussa OUEDRAOGO wrote: > > - TAVLManagedTree that uses a node mem manager provided in the > constructor. > The developer using this one is _aware_ of the thread safety issue and > can > then provide a thread safe node mem manager for an instance exposed What is exactly the add-on value for the node mem manager?

I guess performance, as it is a pooled factory.
I have not test it myself though.

Inoussa O.

Reply by email

Mattias Gaertner
to Micha Nelissen: What is exactly the add-on value for the node mem manager? Micha
Show quoted text 7 lines
Inoussa OUEDRAOGO wrote: > - TAVLManagedTree that uses a node mem manager provided in the > constructor. The developer using this one is _aware_ of the thread > safety issue and can then provide a thread safe node mem manager > for an instance exposed What is exactly the add-on value for the node mem manager?

Only speed.
So it is only needed for such things like the codetools which can create a million nodes. For xml is it probably not that important.

Mattias

Reply by email

Marco van de Voort
to Micha Nelissen: What is exactly the add-on value for the node mem manager? Micha
Show quoted text 6 lines
Inoussa OUEDRAOGO wrote: > - TAVLManagedTree that uses a node mem manager provided in the constructor. > The developer using this one is _aware_ of the thread safety issue and can > then provide a thread safe node mem manager for an instance exposed What is exactly the add-on value for the node mem manager?

I can only think of heap fragmentation and reduction of creation overhead.

Reply by email

Micha Nelissen
to Marco van de Voort
Marco van de Voort wrote 7 lines
> Inoussa OUEDRAOGO wrote: >> - TAVLManagedTree that uses a node mem manager provided in the constructor. >> The developer using this one is _aware_ of the thread safety issue and can >> then provide a thread safe node mem manager for an instance exposed > What is exactly the add-on value for the node mem manager? I can only think of heap fragmentation and reduction of creation overhead.

Yes, but fpc's memory manager also already does this (at least if the allocation size is less than 512 bytes or so).

Before very complex multithreaded implementations are thought up and implemented, it would be wise to see if there really is a significant enough performance boost with the node manager.

Micha

Reply by email

Marco van de Voort
to Micha Nelissen
Show quoted text 11 lines
Marco van de Voort wrote: >> Inoussa OUEDRAOGO wrote: >>> - TAVLManagedTree that uses a node mem manager provided in the constructor. >>> The developer using this one is _aware_ of the thread safety issue and can >>> then provide a thread safe node mem manager for an instance exposed >> What is exactly the add-on value for the node mem manager? > > I can only think of heap fragmentation and reduction of creation overhead. Yes, but fpc's memory manager also already does this (at least if the allocation size is less than 512 bytes or so).

But fpc's memory manager won't be always used. There is cmem, and a future sharemem as options too. And sharemem-likes are known to be slow.

The "memmanager might also do this" might be a reason to not enable it by default, but not a reason to eliminate the possibility all together.

Reply by email

Marc Weustink
to Marco van de Voort
Marco van de Voort wrote 15 lines
> Marco van de Voort wrote: >>> Inoussa OUEDRAOGO wrote: >>>> - TAVLManagedTree that uses a node mem manager provided in the constructor. >>>> The developer using this one is _aware_ of the thread safety issue and can >>>> then provide a thread safe node mem manager for an instance exposed >>> What is exactly the add-on value for the node mem manager? >> I can only think of heap fragmentation and reduction of creation overhead. > Yes, but fpc's memory manager also already does this (at least if the > allocation size is less than 512 bytes or so). But fpc's memory manager won't be always used. There is cmem, and a future sharemem as options too. And sharemem-likes are known to be slow. The "memmanager might also do this" might be a reason to not enable it by default, but not a reason to eliminate the possibility all together.

I'm pro having a manged and an unmanaged avltree. One (big) disadvantage of the current implementation (with a shared node manager for all trees) is that you cannot add custom derived treenodes since they will be released in the pool too.

Marc

Reply by email

Mattias Gärtner
to Marc Weustink

Zitat von Marc Weustink :

Show quoted text 24 lines
Marco van de Voort wrote: >> Marco van de Voort wrote: >>>> Inoussa OUEDRAOGO wrote: >>>>> - TAVLManagedTree that uses a node mem manager provided in the constructor. >>>>> The developer using this one is _aware_ of the thread safety issue and can >>>>> then provide a thread safe node mem manager for an instance exposed >>>> What is exactly the add-on value for the node mem manager? >>> I can only think of heap fragmentation and reduction of creation overhead. >> Yes, but fpc's memory manager also already does this (at least if the >> allocation size is less than 512 bytes or so). > > But fpc's memory manager won't be always used. There is cmem, and a future > sharemem as options too. And sharemem-likes are known to be slow. > > The "memmanager might also do this" might be a reason to not enable it by > default, but not a reason to eliminate the possibility all together. I'm pro having a manged and an unmanaged avltree. One (big) disadvantage of the current implementation (with a shared node manager for all trees) is that you cannot add custom derived treenodes since they will be released in the pool too.

I think too, that we need a fast, lightweight tree and a slower, but customizable tree. Something like TFPList and TList. One without virtual methods and one with virtual methods and definable node class.

Mattias

Reply by email

Henri Gourvest
to Mattias Gärtner

I made 2 AVL tree for different kind of problems

this one is generic (32/64+all platformes)
http://uib.svn.sourceforge.net/viewvc/uib/trunk/source/uibavl.pas?view=markup it is based on http://www.geocities.com/wkaras/gen_c/cavl_tree.html

this one only index string and use both Hash and AVL tree for better performances (32/64+all platformes)
http://jsontoolkit.svn.sourceforge.net/viewvc/jsontoolkit/trunk/superobject.pas?view=markup I use it to store JSON data

You are free to use them

Henri Gourvest

Show quoted text 11 lines
I think too, that we need a fast, lightweight tree and a slower, but customizable tree. Something like TFPList and TList. One without virtual methods and one with virtual methods and definable node class. Mattias _______________________________________________ fpc-devel maillist - http://lists.freepascal.org/mailman/listinfo/fpc-devel

Reply by email

Henri Gourvest
to Henri Gourvest

I just found another one, I made long time ago, I stopped to use it because it is based on libavl and licence is GPL.

unit libavl;
interface
{$ALIGN ON}
{$MINENUMSIZE 4}
const
 MAX_STACK = 32;
type
 TBranchDir = (bLeft, bRight);
 PIndexSlot = ^TIndexSlot;
 TIndexSlot = record
   FData: Pointer;
   FPrev: PIndexSlot;
   FNext: PIndexSlot;
 end;
 PIndexNode = ^TIndexNode;
 TIndexNode = record
   FBranch: array[TBranchDir] of PIndexNode;
   FFirst: TIndexSlot;
   FLast: PIndexSlot;
   FBalance: Integer;
 end;
 TStackNodeArray = array[0..MAX_STACK - 1] of PIndexNode;
 TIndexedList = class
 private
   FRoot: PIndexNode;
   FCount: Cardinal;
   FGeneration: Cardinal;
   FCursor: PIndexNode;
   FCursorSlot: PIndexSlot;
   FStack: TStackNodeArray;
   FStackSize: Cardinal;
   FNeedResync: boolean;
   procedure Resync;
   function GetData: Pointer;
   procedure DeleteItem(const p: PIndexNode);
 protected
   function doCompare(const item1, item2: Pointer): Integer; virtual;
   procedure doDelete(const item: Pointer); virtual;
 public
   constructor Create; virtual;
   destructor Destroy; override;
   procedure Clear;
   function Add(const item: Pointer; unique: boolean): Pointer;
   function Delete(const item: Pointer): Pointer;
   function Find(const item: Pointer): Pointer;
   function First: Pointer;
   function Last: Pointer;
   function Prior: Pointer;
   function Next: Pointer;
   function FindNext: Pointer;
   function FindPrior: Pointer;
   property Data: Pointer read GetData;
   property Count: Cardinal read FCount;
 end;
implementation
uses SysUtils;
type
 TStackDirArray = array[0..MAX_STACK - 1] of TBranchDir;

{ TIndexdList }

function TIndexedList.doCompare(const item1, item2: Pointer): Integer;
begin
 result := 0;
end;
procedure TIndexedList.doDelete(const item: Pointer);
begin
end;
procedure TIndexedList.Resync;
var
 node, i: PIndexNode;
begin
 FNeedResync := False;
 if (FCursor  nil) then
 begin
   node := FCursor;
   FStackSize := 0;
   i := FRoot;
   while i  node do
   begin
     assert(FStackSize < MAX_STACK);
     assert(i  nil);
     FStack[FStackSize] := i;
     inc(FStackSize);
     i := i.FBranch[TBranchDir(
doCompare(node.FFirst.FData, i.FFirst.FData) > 0)];
   end;
 end;
end;
function TIndexedList.GetData: Pointer;
begin
 if FCursorSlot  nil then
   Result := FCursorSlot.FData
 else
   Result := nil;
end;
constructor TIndexedList.Create;
begin
 FRoot := nil;
 FCursor := nil;
 FCursorSlot := nil;
 FCount := 0;
 FGeneration := 0;
 FStackSize := 0;
 FNeedResync := False;
end;
function TIndexedList.Delete(const item: Pointer): Pointer;
var
 na: TStackNodeArray;
 da: TStackDirArray;
 k, j, comp: Integer;
 i: Pointer;
 dir: TBranchDir;
 p1, p2, p3, p4, p5, p6: PIndexNode;
begin
 assert(item  nil);
 p3 := nil;
 k := 0;
 p1 := @FRoot;
 comp := -1;
 while comp  0 do
 begin
   dir := TBranchDir(comp > 0);
   na[k] := p1;
   da[k] := dir;
   inc(k);
   p1 := p1.FBranch[dir];
   if (p1 = nil) then
   begin
     Result := nil;
     exit;
   end;
   comp := doCompare(item, p1.FFirst.FData);
 end;
 i := p1.FFirst.FData;
 if (p1.FBranch[bRight] = nil) then
   na[k - 1].FBranch[da[k - 1]] := p1.FBranch[bLeft]
 else
 begin
   p2 := p1.FBranch[bRight];
   if (p2.FBranch[bLeft] = nil) then
   begin
     p2.FBranch[bLeft] := p1.FBranch[bLeft];
     p2.FBalance := p1.FBalance;
     na[k - 1].FBranch[da[k - 1]] := p2;
     da[k] := bRight;
     na[k] := p2;
     inc(k);
   end
   else
   begin
     j := k;
     inc(k);
     while True do
     begin
       da[k] := bLeft;
       na[k] := p2;
       inc(k);
       p3 := p2.FBranch[bLeft];
       if (p3.FBranch[bLeft] = nil) then
         break;
       p2 := p3;
     end;
     p3.FBranch[bLeft] := p1.FBranch[bLeft];
     p2.FBranch[bLeft] := p3.FBranch[bRight];
     p3.FBranch[bRight] := p1.FBranch[bRight];
     p3.FBalance := p1.FBalance;
     na[j - 1].FBranch[da[j - 1]] := p3;
     da[j] := bRight;
     na[j] := p3;
   end;
 end;
 DeleteItem(p1);
 assert(k > 0);
 dec(k);
 while (k > 0) do
 begin
   p4 := na[k];
   if (da[k] = bLeft) then
   begin
     inc(p4.FBalance);
     if (p4.FBalance = 1) then
       break
     else
       if (p4.FBalance = 2) then
       begin
         p5 := p4.FBranch[bRight];
         if (p5.FBalance = -1) then
         begin
           assert(p5.FBalance = -1);
           p6 := p5.FBranch[bLeft];
           p5.FBranch[bLeft] := p6.FBranch[bRight];
           p6.FBranch[bRight] := p5;
           p4.FBranch[bRight] := p6.FBranch[bLeft];
           p6.FBranch[bLeft] := p4;
           if (p6.FBalance = 1) then
           begin
             p5.FBalance := 0;
             p4.FBalance := -1;
           end
           else
             if (p6.FBalance = 0) then
             begin
               p5.FBalance := 0;
               p4.FBalance := 0;
             end
             else
             begin
               p5.FBalance := 1;
               p4.FBalance := 0;
             end;
           p6.FBalance := 0;
           na[k - 1].FBranch[da[k - 1]] := p6;
         end
         else
         begin
           p4.FBranch[bRight] := p5.FBranch[bLeft];
           p5.FBranch[bLeft] := p4;
           na[k - 1].FBranch[da[k - 1]] := p5;
           if (p5.FBalance = 0) then
           begin
             p5.FBalance := -1;
             p4.FBalance := 1;
             break;
           end
           else
           begin
             p5.FBalance := 0;
             p4.FBalance := 0;
           end;
         end;
       end;
   end
   else
   begin
     dec(p4.FBalance);
     if (p4.FBalance = -1) then
       break
     else
       if (p4.FBalance = -2) then
       begin
         p5 := p4.FBranch[bLeft];
         if (p5.FBalance = 1) then
         begin
           assert(p5.FBalance = 1);
           p6 := p5.FBranch[bRight];
           p5.FBranch[bRight] := p6.FBranch[bLeft];
           p6.FBranch[bLeft] := p5;
           p4.FBranch[bLeft] := p6.FBranch[bRight];
           p6.FBranch[bRight] := p4;
           if (p6.FBalance = -1) then
           begin
             p5.FBalance := 0;
             p4.FBalance := 1;
           end
           else
             if (p6.FBalance = 0) then
             begin
               p5.FBalance := 0;
               p4.FBalance := 0;
             end
             else
             begin
               p5.FBalance := -1;
               p4.FBalance := 0;
             end;
           p6.FBalance := 0;
           na[k - 1].FBranch[da[k - 1]] := p6;
         end
         else
         begin
           p4.FBranch[bLeft] := p5.FBranch[bRight];
           p5.FBranch[bRight] := p4;
           na[k - 1].FBranch[da[k - 1]] := p5;
           if (p5.FBalance = 0) then
           begin
             p5.FBalance := 1;
             p4.FBalance := -1;
             break;
           end
           else
           begin
             p5.FBalance := 0;
             p4.FBalance := 0;
           end;
         end;
       end;
   end;
   dec(k);
 end;
 dec(FCount);
 inc(FGeneration);
 Result := i;
end;
destructor TIndexedList.Destroy;
begin
 Clear;
 inherited;
end;
function TIndexedList.First: Pointer;
var
 p: PIndexNode;
begin
 FStackSize := 0;
 FNeedResync := False;
 p := FRoot;
 if (p  nil) then
   while (p.FBranch[bLeft]  nil) do
   begin
     assert(FStackSize < MAX_STACK);
     FStack[FStackSize] := p;
     inc(FStackSize);
     p := p.FBranch[bLeft];
   end;
 FCursor := p;
 if p  nil then
 begin
   FCursorSlot := @p.FFirst;
   Result := FCursorSlot.FData
 end
 else
 begin
   FCursorSlot := nil;
   Result := nil;
 end;
end;
function TIndexedList.Last: Pointer;
var
 p: PIndexNode;
begin
 FStackSize := 0;
 FNeedResync := False;
 p := FRoot;
 if (p  nil) then
   while (p.FBranch[bRight]  nil) do
   begin
     assert(FStackSize < MAX_STACK);
     FStack[FStackSize] := p;
     inc(FStackSize);
     p := p.FBranch[bRight];
   end;
 FCursor := p;
 if p  nil then
 begin
   FCursorSlot := FCursor.FLast;
   Result := FCursorSlot.FData
 end
 else
 begin
   FCursorSlot := nil;
   Result := nil;
 end;
end;
function TIndexedList.Find(const item: Pointer): Pointer;
var
 p, q: PIndexNode;
 comp: integer;
begin
 assert(item  nil);
 FStackSize := 0;
 FNeedResync := False;
 p := FRoot;
 q := nil;
 while p  nil do
 begin
   comp := doCompare(item, p.FFirst.FData);
   if (comp < 0) then
     q := p.FBranch[bLeft]
   else
     if (comp > 0) then
       q := p.FBranch[bRight]
     else
     begin
       FCursor := p;
       FCursorSlot := @p.FFirst;
       Result := FCursorSlot.FData;
       exit;
     end;
   assert(FStackSize < MAX_STACK);
   FStack[FStackSize] := p;
   inc(FStackSize);
   p := q;
 end;
 FStackSize := 0;
 FCursor := nil;
 FCursorSlot := nil;
 Result := nil;
end;
function TIndexedList.Add(const item: Pointer; unique: boolean): Pointer;
var
 da: TStackDirArray;
 p1, p2, p3, p4, p5, p6, p7: PIndexNode;
 i, comp: Integer;
 dir: TBranchDir;
begin
 assert(item  nil);
 i := 0;
 p7 := @FRoot;
 p6 := FRoot;
 dir := bLeft;
 p3 := p7;
 p2 := p6;
 while p2  nil do
 begin
   comp := doCompare(item, p2.FFirst.FData);
   if (comp = 0) then
   begin
     if unique then
     begin
       FCursor := p2;
       FCursorSlot := @FCursor.FFirst;
       result := FCursorSlot.FData;
       doDelete(item);
     end else
     begin
       FCursor := p2;
       GetMem(FCursorSlot, SizeOf(TIndexSlot));
       FCursorSlot.FData := item;
       FCursorSlot.FPrev := FCursor.FLast;
       FCursorSlot.FNext := nil;
       FCursor.FLast.FNext := FCursorSlot;
       FCursor.FLast := FCursorSlot;
       FNeedResync := True;
       Result := FCursorSlot.FData;
       inc(FCount);
     end;
     exit;
   end;
   if (p2.FBalance  0) then
   begin
     p7 := p3;
     p6 := p2;
     i := 0;
   end;
   dir := TBranchDir(comp > 0);
   da[i] := dir;
   inc(i);
   p3 := p2;
   p2 := p2.FBranch[dir]
 end;
 GetMem(p1, sizeof(TIndexNode));
 p3.FBranch[dir] := p1;
 inc(FCount);
 p1.FFirst.FData := item;
 p1.FFirst.FNext := nil;
 p1.FFirst.FPrev := nil;
 p1.FLast := @p1.FFirst;
 p1.FBranch[bLeft] := nil;
 p1.FBranch[bRight] := nil;
 p1.FBalance := 0;
 if (p6 = nil) then
 begin
   FCursor := p1;
   FCursorSlot := @p1.FFirst;
   FNeedResync := True;
   Result := FCursorSlot.FData;
   exit;
 end;
 p2 := p6;
 i := 0;
 while p2  p1 do
 begin
   if (da[i] = bLeft) then
     dec(p2.FBalance)
   else
     inc(p2.FBalance);
   p2 := p2.FBranch[da[i]];
   inc(i);
 end;
 if (p6.FBalance = -2) then
 begin
   p5 := p6.FBranch[bLeft];
   if (p5.FBalance = -1) then
   begin
     p4 := p5;
     p6.FBranch[bLeft] := p5.FBranch[bRight];
     p5.FBranch[bRight] := p6;
     p5.FBalance := 0;
     p6.FBalance := 0;
   end
   else
   begin
     assert(p5.FBalance = 1);
     p4 := p5.FBranch[bRight];
     p5.FBranch[bRight] := p4.FBranch[bLeft];
     p4.FBranch[bLeft] := p5;
     p6.FBranch[bLeft] := p4.FBranch[bRight];
     p4.FBranch[bRight] := p6;
     if (p4.FBalance = -1) then
     begin
       p5.FBalance := 0;
       p6.FBalance := 1;
     end
     else
       if (p4.FBalance = 0) then
       begin
         p5.FBalance := 0;
         p6.FBalance := 0;
       end
       else
       begin
         p5.FBalance := -1;
         p6.FBalance := 0;
       end;
     p4.FBalance := 0;
   end;
 end
 else
   if (p6.FBalance = 2) then
   begin
     p5 := p6.FBranch[bRight];
     if (p5.FBalance = 1) then
     begin
       p4 := p5;
       p6.FBranch[bRight] := p5.FBranch[bLeft];
       p5.FBranch[bLeft] := p6;
       p5.FBalance := 0;
       p6.FBalance := 0;
     end
     else
     begin
       assert(p5.FBalance = -1);
       p4 := p5.FBranch[bLeft];
       p5.FBranch[bLeft] := p4.FBranch[bRight];
       p4.FBranch[bRight] := p5;
       p6.FBranch[bRight] := p4.FBranch[bLeft];
       p4.FBranch[bLeft] := p6;
       if (p4.FBalance = 1) then
       begin
         p5.FBalance := 0;
         p6.FBalance := -1;
       end
       else
         if (p4.FBalance = 0) then
         begin
           p5.FBalance := 0;
           p6.FBalance := 0;
         end
         else
         begin
           p5.FBalance := 1;
           p6.FBalance := 0;
         end;
       p4.FBalance := 0;
     end;
   end
   else
   begin
     FCursor := p1;
     FCursorSlot := @p1.FFirst;
     FNeedResync := True;
     Result := FCursorSlot.FData;
     exit;
   end;
 p7.FBranch[TBranchDir(p6  p7.FBranch[bLeft])] := p4;
 inc(FGeneration);
 FCursor := p1;
 FCursorSlot := @p1.FFirst;
 FNeedResync := True;
 Result := FCursorSlot.FData;
end;
function TIndexedList.Next: Pointer;
var
 p1, p2: PIndexNode;
begin
 if FNeedResync then
   Resync;
 Result := FindNext;
 if Result  nil then
   Exit;
 p1 := FCursor;
 if (p1 = nil) then
 begin
   Result := First;
   exit;
 end
 else
   if (p1.FBranch[bRight]  nil) then
   begin
     assert(FStackSize < MAX_STACK);
     FStack[FStackSize] := p1;
     inc(FStackSize);
     p1 := p1.FBranch[bRight];
     while (p1.FBranch[bLeft]  nil) do
     begin
       assert(FStackSize < MAX_STACK);
       FStack[FStackSize] := p1;
       inc(FStackSize);
       p1 := p1.FBranch[bLeft];
     end;
   end
   else
     repeat
       if (FStackSize = 0) then
       begin
         FCursor := nil;
         FCursorSlot := nil;
         Result := nil;
         exit;
       end;
       p2 := p1;
       dec(FStackSize);
       p1 := FStack[FStackSize];
     until (p2  p1.FBranch[bRight]);
 FCursor := p1;
 FCursorSlot := @p1.FFirst;
 Result := FCursorSlot.FData;
end;
function TIndexedList.Prior: Pointer;
var
 p1, p2: PIndexNode;
begin
 if FNeedResync then
   Resync;
 Result := FindPrior;
 if Result  nil then
   Exit;
 p1 := FCursor;
 if (p1 = nil) then
 begin
   Result := Last;
   exit;
 end
 else
   if (p1.FBranch[bLeft]  nil) then
   begin
     assert(FStackSize < MAX_STACK);
     FStack[FStackSize] := p1;
     inc(FStackSize);
     p1 := p1.FBranch[bLeft];
     while (p1.FBranch[bRight]  nil) do
     begin
       assert(FStackSize < MAX_STACK);
       FStack[FStackSize] := p1;
       inc(FStackSize);
       p1 := p1.FBranch[bRight];
     end;
   end
   else
     repeat
       if (FStackSize = 0) then
       begin
         FCursor := nil;
         FCursorSlot := nil;
         Result := nil;
         exit;
       end;
       p2 := p1;
       dec(FStackSize);
       p1 := FStack[FStackSize];
     until (p2  p1.FBranch[bLeft]);
 FCursor := p1;
 FCursorSlot := @p1.FFirst;
 Result := FCursorSlot.FData;
end;
procedure TIndexedList.Clear;
var
 p1, p2: PIndexNode;
begin
 p1 := FRoot;
 while p1  nil do
 begin
   if (p1.FBranch[bLeft] = nil) then
   begin
     p2 := p1.FBranch[bRight];
     DeleteItem(p1);
   end
   else
   begin
     p2 := p1.FBranch[bLeft];
     p1.FBranch[bLeft] := p2.FBranch[bRight];
     p2.FBranch[bRight] := p1;
   end;
   p1 := p2;
 end;
 FRoot := nil;
 FCount := 0;
 FGeneration := 0;
 FCursor := nil;
 FCursorSlot := nil;
 FStackSize := 0;
 FNeedResync := False;
end;
procedure TIndexedList.DeleteItem(const p: PIndexNode);
var
 p1, p2: PIndexSlot;
begin
 doDelete(p.FFirst.FData);
 p1 := p.FFirst.FNext;
 while p1  nil do
 begin
   if p1.FData  nil then
     doDelete(p1.FData);
   p2 := p1;
   p1 := p2.FNext;
   FreeMem(p2);
   dec(FCount);
 end;
 FreeMem(p);
end;
function TIndexedList.FindNext: Pointer;
begin
 if FCursorSlot  nil then
 begin
   FCursorSlot := FCursorSlot.FNext;
   if FCursorSlot  nil then
     Result := FCursorSlot.FData else
     Result := nil;
 end else
   Result := nil
end;
function TIndexedList.FindPrior: Pointer;
begin
 if FCursorSlot  nil then
 begin
   FCursorSlot := FCursorSlot.FPrev;
   if FCursorSlot  nil then
     Result := FCursorSlot.FData else
     Result := nil;
 end else
   Result := nil
end;
end.

Reply by email

Mattias Gärtner
to Henri Gourvest: I made 2 AVL tree for different kind of problems this one is generic (32/64+all…

Zitat von Henri Gourvest :

Show quoted text 5 lines
I made 2 AVL tree for different kind of problems this one is generic (32/64+all platformes) http://uib.svn.sourceforge.net/viewvc/uib/trunk/source/uibavl.pas?view=markup it is based on http://www.geocities.com/wkaras/gen_c/cavl_tree.html

Correct me if I'm wrong, but this seems not very comfortable.
- No custom sort function (unless you override)
- A node does not know its parent. So with First or Search you can not get to the next node. You need always an iterator (iterators should be optional).
- no function to resort the tree
- no functions to reorder nodes with same keys
- You have to override to actually store some data
- it's not 64bit save

this one only index string and use both Hash and AVL tree for better performances (32/64+all platformes)

http://jsontoolkit.svn.sourceforge.net/viewvc/jsontoolkit/trunk/superobject.pas?view=markup

I use it to store JSON data

This seems to have the same limitations. ?

Mattias

Show quoted text 19 lines
You are free to use them Henri Gourvest > I think too, that we need a fast, lightweight tree and a slower, but > customizable tree. Something like TFPList and TList. One without virtual > methods and one with virtual methods and definable node class. > > > Mattias > > _______________________________________________ > fpc-devel maillist - > http://lists.freepascal.org/mailman/listinfo/fpc-devel > _______________________________________________ fpc-devel maillist - http://lists.freepascal.org/mailman/listinfo/fpc-devel

------------------
Powered by NetMail

Reply by email

Henri Gourvest
to Mattias Gärtner

2008/8/8 Mattias Gärtner :

Correct me if I'm wrong, but this seems not very comfortable. - No custom sort function (unless you override)

...

- A node does not know its parent. So with First or Search you can not get to the next node. You need always an iterator (iterators should be optional).

it is your own opinion, personnaly I need more than one cursor on the tree.

- no function to resort the tree

the tree is autobalanced

- no functions to reorder nodes with same keys

it is useless, you can do everything in the same compare function if you have more than one key.

- You have to override to actually store some data

You are describing an avl tree, it do exactly what it expected to do regardless of data type.

it is usefull for me, I hope it will be usefull for someoneelse.

- it's not 64bit save

8-| why do you say that ?

Henri Gourvest

Reply by email

Mattias Gärtner
to Henri Gourvest

Zitat von Henri Gourvest :

Show quoted text 9 lines
2008/8/8 Mattias Gärtner : > Correct me if I'm wrong, but this seems not very comfortable. > - No custom sort function (unless you override) ... > - A node does not know its parent. So with First or Search you can not get to > the next node. You need always an iterator (iterators should be optional). it is your own opinion, personnaly I need more than one cursor on the tree.

I meant: I can not use the First to get to the second. I must create an iterator.
The current avl tree has a 'parent' of each node, so you can have as many 'cursors' as you want without iterators. I know this costs an extra pointer memory per node, which might be bad in some cases. But I was talking about comfort.

> - no function to resort the tree the tree is autobalanced

.. with a compare function. If you want to change the compare function, you need to create a new avl tree and add manually all nodes. The current FPC avl tree has a simple property for the compare function which can be set any time.

> - no functions to reorder nodes with same keys it is useless, you can do everything in the same compare function if you have more than one key.

I meant: For example: two different items with Compare(Item1,Item2)=0. The order between those two is free and the avl tree does not care. So I can reorder them. This is needed in some algorithms. You can work around this, but it is comfortable to have the ability.

> - You have to override to actually store some data You are describing an avl tree, it do exactly what it expected to do regardless of data type.

I meant the default tree can not even store a pointer. You have to create a descendant.

it is usefull for me, I hope it will be usefull for someoneelse.

No offense meant. I just pointed out, that it misses some nice-to-haves.

> - it's not 64bit save 8-| why do you say that ?
Because of this:
AVL_MAX_DEPTH = sizeof(longint) * 8;

Mattias

Reply by email

Mattias Gaertner
to Henri Gourvest
> Because of this: > AVL_MAX_DEPTH = sizeof(longint) * 8; = 32 in all cases, I know and It is not a problem.

At least not now. But eventually it should be changed to

AVL_MAX_DEPTH = sizeof(PtrInt) * 8;

Mattias

Reply by email

Henri Gourvest
to Mattias Gaertner

this limit depend on the max size of a "set of" data type because I store the enumerator stack in an Integer value. TAvlBitArray = set of 0..AVL_MAX_DEPTH - 1;
unfortunally on FPC 2.2.0 64:

  if TAvlBitArray = set of 0..63;
  sizeof(TAvlBitArray) is still 32

I don't know if it will be changed later, I hope ... but I think 32 is more than enough

henri

2008/8/8 Mattias Gaertner :

Show quoted text 17 lines
On Fri, 8 Aug 2008 14:57:36 +0200 "Henri Gourvest" wrote: > > Because of this: > > AVL_MAX_DEPTH = sizeof(longint) * 8; > > = 32 in all cases, I know and It is not a problem. At least not now. But eventually it should be changed to AVL_MAX_DEPTH = sizeof(PtrInt) * 8; Mattias _______________________________________________ fpc-devel maillist - http://lists.freepascal.org/mailman/listinfo/fpc-devel

Reply by email

Henri Gourvest
to Henri Gourvest

arf, 32bytes not 32bit!
it seem to work now, good new :)
I apologize

2008/8/8 Henri Gourvest :

Show quoted text 32 lines
this limit depend on the max size of a "set of" data type because I store the enumerator stack in an Integer value. TAvlBitArray = set of 0..AVL_MAX_DEPTH - 1; unfortunally on FPC 2.2.0 64: if TAvlBitArray = set of 0..63; sizeof(TAvlBitArray) is still 32 I don't know if it will be changed later, I hope ... but I think 32 is more than enough henri 2008/8/8 Mattias Gaertner : > On Fri, 8 Aug 2008 14:57:36 +0200 > "Henri Gourvest" wrote: > >> > Because of this: >> > AVL_MAX_DEPTH = sizeof(longint) * 8; >> >> = 32 in all cases, I know and It is not a problem. > > At least not now. But eventually it should be changed to > > AVL_MAX_DEPTH = sizeof(PtrInt) * 8; > > Mattias > _______________________________________________ > fpc-devel maillist - > http://lists.freepascal.org/mailman/listinfo/fpc-devel >

Reply by email