Quelle avltree.gi Sprache: unbekannt

#############################################################################
##
##                             orb package
##  avltree.gi
##                                                          Juergen Mueller
##                                                          Max Neunhoeffer
##                                                             Felix Noeske
##
##  Copyright 2009-2009 by the authors.
##  This file is free software, see license information at the end.
##
##  Implementation stuff for AVL trees in GAP.
##
##  adding, removing and finding in O(log n), n is number of nodes
##
##  see Knuth: "The Art of Computer Programming" for algorithms
##
#############################################################################

#
# Conventions:
#
# A balanced binary tree (AVLTree) is a positional object having the
# following entries:
#   ![1]     len: last used entry (never shrinks), always = 3 mod 4
#   ![2]     free: index of first freed entry, if 0, none free
#   ![3]     nodes: number of nodes currently in the tree
#   ![4]     alloc: highest allocated index, always = 3 mod 4
#   ![5]     three-way comparison function
#   ![6]     top: reference to top node
#   ![7]     value: plain list holding the values stored under the keys
#            can be fail, in which case all stored values are "true"
#            will be bound when first value other than true is set
#
# From index 8 on for every position = 0 mod 4:
#   ![4n]    obj: an object
#   ![4n+1]  left: left reference or < 8 (elements there are smaller)
#   ![4n+2]  right: right reference or < 8 (elements there are bigger)
#   ![4n+3]  rank: number of nodes in left subtree plus one
# For freed nodes position ![4n] holds the link to the next one
# For used nodes references are divisible by four, therefore
# the mod 4 value can be used for other information.
# We use left mod 4: 0 - balanced
#                    1 - balance factor +1
#                    2 - balance factor -1
#

AVLCmp_GAP := function(a,b)
  if a = b then
    return 0;
  elif a < b then
    return -1;
  else
    return 1;
  fi;
end;
if IsBound(AVLCmp_C) then
    InstallGlobalFunction(AVLCmp, AVLCmp_C);
else
    InstallGlobalFunction(AVLCmp, AVLCmp_GAP);
fi;

AVLTree_GAP := function(arg)
  # Parameters: options record (optional)
  # Initializes balanced binary tree object, optionally with comparison
  # function. Returns empty tree object.
  # A comparison function takes 2 arguments and returns respectively -1, 0
  # or 1 if the first argument is smaller than, equal to, or bigger than the
  # second argument.
  # A comparison function is NOT necessary for trees where the ordering is
  # only defined by the tree and not by an ordering of the elements. Such
  # trees are managed by the special functions below. Specify nothing
  # for the cmpfunc (or leave the default one).
  local t,cmpfunc,alloc,opt;
  # defaults:
  cmpfunc := AVLCmp;
  alloc := 11;
  if Length(arg) = 1 then
      opt := arg[1];
      if not(IsRecord(opt)) then
          Error("Argument must be an options record!");
          return fail;
      fi;
      if IsBound(opt.cmpfunc) then
          cmpfunc := opt.cmpfunc;
          if not(IsFunction(cmpfunc)) then
              Error("cmdfunc must be a three-way comparison function");
              return fail;
          fi;
      fi;
      if IsBound(opt.allocsize) then
          alloc := opt.allocsize;
          if not(IsInt(alloc)) then
              Error("allocsize must be a positive integer");
          fi;
          alloc := alloc*4+3;
      fi;
  elif Length(arg) <> 0 then
      Error("Usage: AVLTree( [options-record] )");
      return fail;
  fi;
  t := [11,8,0,alloc,cmpfunc,0,fail,0,0,0,0];
  if alloc > 11 then t[alloc] := fail; fi;    # expand object
  Objectify(AVLTreeTypeMutable,t);
  return t;
end;
if IsBound(AVLTree_C) then
    InstallGlobalFunction(AVLTree, AVLTree_C);
else
    InstallGlobalFunction(AVLTree, AVLTree_GAP);
fi;

InstallMethod( ViewObj, "for an avltree object",
  [IsAVLTree and IsAVLTreeFlatRep],
  function( t )
    Print("<avltree nodes=",t![3]," alloc=",t![4],">");
  end );

AVLNewNode_GAP := function(t)
  local n;
  if t![2] > 0 then
      n := t![2];
      t![2] := t![n];
  elif t![1] < t![4] then
      n := t![1]+1;
      t![1] := t![1]+4;
  else
      n := t![4]+1;
      t![4] := t![4] * 2 + 1;    # retain congruent 3 mod 4
      t![1] := n+3;
      t![t![4]] := fail;    # expand allocation
  fi;
  t![n] := 0;
  t![n+1] := 0;
  t![n+2] := 0;
  t![n+3] := 0;
  return n;
end;
if IsBound(AVLNewNode_C) then
    InstallGlobalFunction(AVLNewNode, AVLNewNode_C);
else
    InstallGlobalFunction(AVLNewNode, AVLNewNode_GAP);
fi;

AVLFreeNode_GAP := function(t,n)
  local o;
  t![n] := t![2];
  t![2] := n;
  n := n/4;
  if t![7] <> fail and IsBound(t![7][n]) then
      o := t![7][n];
      Unbind(t![7][n]);
      return o;
  fi;
  return true;
end;
if IsBound(AVLFreeNode_C) then
    InstallGlobalFunction(AVLFreeNode, AVLFreeNode_C);
else
    InstallGlobalFunction(AVLFreeNode, AVLFreeNode_GAP);
fi;

AVLData_GAP := function(t,n)
  return t![n];
end;
if IsBound(AVLData_C) then
    InstallGlobalFunction(AVLData, AVLData_C);
else
    InstallGlobalFunction(AVLData, AVLData_GAP);
fi;

AVLSetData_GAP := function(t,n,d)
  t![n] := d;
end;
if IsBound(AVLSetData_C) then
    InstallGlobalFunction(AVLSetData, AVLSetData_C);
else
    InstallGlobalFunction(AVLSetData, AVLSetData_GAP);
fi;

AVLLeft_GAP := function(t,n)
  return QuoInt(t![n+1],4)*4;
end;
if IsBound(AVLLeft_C) then
    InstallGlobalFunction(AVLLeft, AVLLeft_C);
else
    InstallGlobalFunction(AVLLeft, AVLLeft_GAP);
fi;

AVLSetLeft_GAP := function(t,n,m)
  t![n+1] := m + t![n+1] mod 4;
end;
if IsBound(AVLSetLeft_C) then
    InstallGlobalFunction(AVLSetLeft, AVLSetLeft_C);
else
    InstallGlobalFunction(AVLSetLeft, AVLSetLeft_GAP);
fi;

AVLRight_GAP := function(t,n)
  return QuoInt(t![n+2],4)*4;
end;
if IsBound(AVLRight_C) then
    InstallGlobalFunction(AVLRight, AVLRight_C);
else
    InstallGlobalFunction(AVLRight, AVLRight_GAP);
fi;

AVLSetRight_GAP := function(t,n,m)
  t![n+2] := m;
end;
if IsBound(AVLSetRight_C) then
    InstallGlobalFunction(AVLSetRight, AVLSetRight_C);
else
    InstallGlobalFunction(AVLSetRight, AVLSetRight_GAP);
fi;

AVLRank_GAP := function(t,n)
  return t![n+3];
end;
if IsBound(AVLRank_C) then
    InstallGlobalFunction(AVLRank, AVLRank_C);
else
    InstallGlobalFunction(AVLRank, AVLRank_GAP);
fi;

AVLSetRank_GAP := function(t,n,r)
  t![n+3] := r;
end;
if IsBound(AVLSetRank_C) then
    InstallGlobalFunction(AVLSetRank, AVLSetRank_C);
else
    InstallGlobalFunction(AVLSetRank, AVLSetRank_GAP);
fi;

AVLBalFactor_GAP := function(t,n)
  local bf;
  bf := t![n+1] mod 4;    # 0, 1 or 2
  if bf = 2 then
    return -1;
  else
    return bf;
  fi;
end;
if IsBound(AVLBalFactor_C) then
    InstallGlobalFunction(AVLBalFactor, AVLBalFactor_C);
else
    InstallGlobalFunction(AVLBalFactor, AVLBalFactor_GAP);
fi;

AVLSetBalFactor_GAP := function(t,n,bf)
  if bf = -1 then
    t![n+1] := QuoInt(t![n+1],4)*4 + 2;
  else
    t![n+1] := QuoInt(t![n+1],4)*4 + bf;
  fi;
end;
if IsBound(AVLSetBalFactor_C) then
    InstallGlobalFunction(AVLSetBalFactor, AVLSetBalFactor_C);
else
    InstallGlobalFunction(AVLSetBalFactor, AVLSetBalFactor_GAP);
fi;

AVLValue_GAP := function(t,n)
  if t![7] = fail then
      return true;
  elif not(IsBound(t![7][n/4])) then
      return true;
  else
      return t![7][n/4];
  fi;
end;
if IsBound(AVLValue_C) then
    InstallGlobalFunction(AVLValue, AVLValue_C);
else
    InstallGlobalFunction(AVLValue, AVLValue_GAP);
fi;

AVLSetValue_GAP := function(t,n,v)
  n := n/4;
  if t![7] = fail then
      t![7] := EmptyPlist(n);
  fi;
  t![7][n] := v;
end;
if IsBound(AVLSetValue_C) then
    InstallGlobalFunction(AVLSetValue, AVLSetValue_C);
else
    InstallGlobalFunction(AVLSetValue, AVLSetValue_GAP);
fi;

InstallMethod( Display, "for an avltree object",
  [IsAVLTree and IsAVLTreeFlatRep],
  function( t )
    local DoRecursion;
    DoRecursion := function(p,depth,P)
      local i;
      if p = 0 then return; fi;
      for i in [1..depth] do Print(" "); od;
      Print(P,"data=",AVLData(t,p)," rank=",AVLRank(t,p)," pos=",p,
            " bf=",AVLBalFactor(t,p),"\n");
      DoRecursion(AVLLeft(t,p),depth+1,"L:");
      DoRecursion(AVLRight(t,p),depth+1,"R:");
    end;

    Print("<avltree nodes=",t![3]," alloc=",t![4],"\n");
    DoRecursion(t![6],1,"");
    Print(">\n");
  end );

AVLFind_GAP := function(tree,data)
  # Parameters: tree, data
  #  t is a AVL
  #  data is a data structure defined by the user
  # Searches in tree for a node equal to data, returns this node or fail
  # if not found.
  local compare, p, c;
  compare := tree![5];
  p := tree![6];
  while p >= 8 do
    c := compare(data,AVLData(tree,p));
    if c = 0 then
      return p;
    elif c < 0 then    # data < AVLData(tree,p)
      p := AVLLeft(tree,p);
    else               # data > AVLData(tree,p)
      p := AVLRight(tree,p);
    fi;
  od;

  return fail;
end;
if IsBound(AVLFind_C) then
    InstallGlobalFunction(AVLFind, AVLFind_C);
else
    InstallGlobalFunction(AVLFind, AVLFind_GAP);
fi;

AVLLookup_GAP := function(t,d)
  local p;
  p := AVLFind(t,d);
  if p = fail then
      return fail;
  else
      return AVLValue(t,p);
  fi;
end;
if IsBound(AVLLookup_C) then
    InstallGlobalFunction(AVLLookup, AVLLookup_C);
else
    InstallGlobalFunction(AVLLookup, AVLLookup_GAP);
fi;

AVLIndex_GAP := function(tree,index)
  # Parameters: tree, index
  #  tree is a AVL
  #  index is an index in the tree
  # Searches in tree for the node with index index, returns the data of
  # this node or fail if not found. Works without comparison function,
  # just by index.
  local p, offset, r;

  if index < 1 or index > tree![3] then
    return fail;
  fi;

  p := tree![6];
  offset := 0;         # Offset of subtree p in tree

  while true do   # will terminate!
    r := offset + AVLRank(tree,p);
    if index < r then
      # go left
      p := AVLLeft(tree,p);
    elif index = r then
      # found!
      return AVLData(tree,p);
    else
      # go right!
      offset := r;
      p := AVLRight(tree,p);
    fi;
  od;
end;
if IsBound(AVLIndex_C) then
    InstallGlobalFunction(AVLIndex, AVLIndex_C);
else
    InstallGlobalFunction(AVLIndex, AVLIndex_GAP);
fi;

AVLIndexFind_GAP := function(tree,index)
  # Parameters: tree, index
  #  tree is a AVL
  #  index is an index in the tree
  # Searches in tree for the node with index index, returns the position of
  # this node or fail if not found. Works without comparison function,
  # just by index.
  local p, offset, r;

  if index < 1 or index > tree![3] then
    return fail;
  fi;

  p := tree![6];
  offset := 0;         # Offset of subtree p in tree

  while true do   # will terminate!
    r := offset + AVLRank(tree,p);
    if index < r then
      # go left
      p := AVLLeft(tree,p);
    elif index = r then
      # found!
      return p;
    else
      # go right!
      offset := r;
      p := AVLRight(tree,p);
    fi;
  od;
end;
if IsBound(AVLIndexFind_C) then
    InstallGlobalFunction(AVLIndexFind, AVLIndexFind_C);
else
    InstallGlobalFunction(AVLIndexFind, AVLIndexFind_GAP);
fi;

AVLIndexLookup_GAP := function(tree,i)
  local p;
  p := AVLIndexFind(tree,i);
  if p = fail then
      return fail;
  else
      return AVLValue(tree,p);
  fi;
end;
if IsBound(AVLIndexLookup_C) then
    InstallGlobalFunction(AVLIndexLookup, AVLIndexLookup_C);
else
    InstallGlobalFunction(AVLIndexLookup, AVLIndexLookup_GAP);
fi;

AVLRebalance_GAP := function(tree,q)
  # the tree starting at q has balanced subtrees but is out of balance:
  # the depth of the deeper subtree is 2 bigger than the depth of the other
  # tree. This function changes this situation following the procedure
  # described in Knuth: "The Art of Computer Programming".
  # It returns a record with the new start node of the subtree as entry
  # "newroot" and in "shorter" a boolean value which indicates, if the
  # depth of the tree was decreased by 1 by this operation.
  local shrink, p, l;

  shrink := true;   # in nearly all cases this happens
  if AVLBalFactor(tree,q) < 0 then
    p := AVLLeft(tree,q);
  else
    p := AVLRight(tree,q);
  fi;
  if AVLBalFactor(tree,p) = AVLBalFactor(tree,q) then
    # we need a single rotation:
    #       q++             p=           q--          p=
    #      / \             / \          / \          / \
    #     a   p+    ==>   q=  c    OR  p-  c   ==>  a   q=
    #        / \         / \          / \              / \
    #       b   c       a   b        a   b            b   c
    if AVLBalFactor(tree,q) > 0 then
      AVLSetRight(tree,q,AVLLeft(tree,p));
      AVLSetLeft(tree,p,q);
      AVLSetBalFactor(tree,q,0);
      AVLSetBalFactor(tree,p,0);
      AVLSetRank(tree,p,AVLRank(tree,p) + AVLRank(tree,q));
    else
      AVLSetLeft(tree,q,AVLRight(tree,p));
      AVLSetRight(tree,p,q);
      AVLSetBalFactor(tree,q,0);
      AVLSetBalFactor(tree,p,0);
      AVLSetRank(tree,q,AVLRank(tree,q) - AVLRank(tree,p));
    fi;
  elif AVLBalFactor(tree,p) = - AVLBalFactor(tree,q) then
    # we need a double rotation:
    #       q++                             q--
    #      / \             c=              / \            c=
    #     a   p-         /   \            p+  e         /   \
    #        / \   ==>  q     p    OR    / \      ==>  p     q
    #       c   e      / \   / \        a   c         / \   / \
    #      / \        a   b d   e          / \       a   b d   e
    #     b   d                           b   d
    if AVLBalFactor(tree,q) > 0 then
      l := AVLLeft(tree,p);
      AVLSetRight(tree,q,AVLLeft(tree,l));
      AVLSetLeft(tree,p,AVLRight(tree,l));
      AVLSetLeft(tree,l,q);
      AVLSetRight(tree,l,p);
      if AVLBalFactor(tree,l) > 0 then
        AVLSetBalFactor(tree,p,0);
        AVLSetBalFactor(tree,q,-1);
      elif AVLBalFactor(tree,l) = 0 then
        AVLSetBalFactor(tree,p,0);
        AVLSetBalFactor(tree,q,0);
      else    # AVLBalFactor(tree,l) < 0
        AVLSetBalFactor(tree,p,1);
        AVLSetBalFactor(tree,q,0);
      fi;
      AVLSetBalFactor(tree,l,0);
      AVLSetRank(tree,p,AVLRank(tree,p) - AVLRank(tree,l));
      AVLSetRank(tree,l,AVLRank(tree,l) + AVLRank(tree,q));
      p := l;
    else
      l := AVLRight(tree,p);
      AVLSetLeft(tree,q,AVLRight(tree,l));
      AVLSetRight(tree,p,AVLLeft(tree,l));
      AVLSetLeft(tree,l,p);
      AVLSetRight(tree,l,q);
      if AVLBalFactor(tree,l) < 0 then
        AVLSetBalFactor(tree,p,0);
        AVLSetBalFactor(tree,q,1);
      elif AVLBalFactor(tree,l) = 0 then
        AVLSetBalFactor(tree,p,0);
        AVLSetBalFactor(tree,q,0);
      else    # AVLBalFactor(tree,l) > 0
        AVLSetBalFactor(tree,p,-1);
        AVLSetBalFactor(tree,q,0);
      fi;
      AVLSetBalFactor(tree,l,0);
      AVLSetRank(tree,l,AVLRank(tree,l) + AVLRank(tree,p));
      AVLSetRank(tree,q,AVLRank(tree,q) - AVLRank(tree,l));
                           # new value of AVLRank(tree,l)!
      p := l;
    fi;
  else   # AVLBalFactor(tree,p) = 0 then
    # we need a single rotation:
    #       q++             p-           q--          p+
    #      / \             / \          / \          / \
    #     a   p=    ==>   q+  c    OR  p=  c   ==>  a   q-
    #        / \         / \          / \              / \
    #       b   c       a   b        a   b            b   c
    if AVLBalFactor(tree,q) > 0 then
      AVLSetRight(tree,q,AVLLeft(tree,p));
      AVLSetLeft(tree,p,q);
      AVLSetBalFactor(tree,q,1);
      AVLSetBalFactor(tree,p,-1);
      AVLSetRank(tree,p,AVLRank(tree,p) + AVLRank(tree,q));
    else
      AVLSetLeft(tree,q,AVLRight(tree,p));
      AVLSetRight(tree,p,q);
      AVLSetBalFactor(tree,q,-1);
      AVLSetBalFactor(tree,p,1);
      AVLSetRank(tree,q,AVLRank(tree,q) - AVLRank(tree,p));
    fi;
    shrink := false;
  fi;
  return rec(newroot := p, shorter := shrink);
end;
if IsBound(AVLRebalance_C) then
    InstallGlobalFunction(AVLRebalance, AVLRebalance_C);
else
    InstallGlobalFunction(AVLRebalance, AVLRebalance_GAP);
fi;

AVLAdd_GAP := function(tree,data,value)
  # Parameters: tree, data, value
  #  tree is a AVL
  #  data is a data structure defined by the user
  #  value is the value stored under the key data, if true, nothing is stored
  # Tries to add the data as a node in tree. It is an error, if there is
  # already a node which is "equal" to data with respect to the comparison
  # function. Returns true if everything went well or fail, if an equal
  # object is already present.

  local compare, p, new, path, nodes, n, q, rankadds, c, l, i;

  compare := tree![5];

  p := tree![6];
  if p = 0 then   # A new, single node in the tree
    new := AVLNewNode(tree);
    AVLSetLeft(tree,new,0);
    AVLSetRight(tree,new,0);
    AVLSetBalFactor(tree,new,0);
    AVLSetRank(tree,new,1);
    AVLSetData(tree,new,data);
    if value <> true then
        AVLSetValue(tree,new,value);
    fi;
    tree![3] := 1;
    tree![6] := new;
    return true;
  fi;

  # let's first find the right position in the tree:
  # but: remember the last node on the way with bal. factor <> 0 and the path
  #      after this node
  # and: remember the nodes where the Rank entry is incremented in case we
  #      find an "equal" element
  path := EmptyPlist(10);   # here all steps are recorded: -1:left, +1:right
  nodes := EmptyPlist(10);
  nodes[1] := p;   # here we store all nodes on our way, nodes[i+1] is reached
                   # from nodes[i] by walking one step path[i]
  n := 1;          # this is the length of "nodes"
  q := 0;          # this is the last node with bal. factor <> 0
                   # index in "nodes" or 0 for no such node
  rankadds := EmptyPlist(10);# nothing done so far, list of Rank-modified nodes
  repeat

    # do we have to remember this position?
    if AVLBalFactor(tree,p) <> 0 then
      q := n;       # forget old last node with balance factor <> 0
    fi;

    # now one step:
    c := compare(data,AVLData(tree,p));
    if c = 0 then   # we did not want this!
      for p in rankadds do
        AVLSetRank(tree,p,AVLRank(tree,p) - 1);
      od;
      return fail; # tree is unchanged
    fi;

    l := p;     # remember last position
    if c < 0 then   # data < AVLData(tree,p)
      AVLSetRank(tree,p,AVLRank(tree,p) + 1);
      Add(rankadds,p);
      p := AVLLeft(tree,p);
    else            # data > AVLData(tree,p)
      p := AVLRight(tree,p);
    fi;
    Add(nodes,p);
    n := n + 1;
    Add(path,c);

  until p = 0;
  # now p is 0 and nodes[n-1] is the node where data must be attached
  # the tree must be modified between nodes[q] and nodes[n-1] along path
  # Ranks are already done
  l := nodes[n-1];   # for easier reference

  # a new node:
  p := AVLNewNode(tree);
  AVLSetLeft(tree,p,0);
  AVLSetRight(tree,p,0);
  AVLSetBalFactor(tree,p,0);
  AVLSetRank(tree,p,1);
  AVLSetData(tree,p,data);
  if value <> true then
      AVLSetValue(tree,p,value);
  fi;
  # insert into tree:
  if c < 0 then    # left
    AVLSetLeft(tree,l,p);
  else
    AVLSetRight(tree,l,p);
  fi;
  tree![3] := tree![3] + 1;

  # modify balance factors between q and l:
  for i in [q+1..n-1] do
    AVLSetBalFactor(tree,nodes[i],path[i]);
  od;

  # is rebalancing at q necessary?
  if q = 0 then    # whole tree has grown one step
    return true;   # Success!
  fi;
  if AVLBalFactor(tree,nodes[q]) = -path[q] then
    # the subtree at q has gotten more balanced
    AVLSetBalFactor(tree,nodes[q],0);
    return true;   # Success!
  fi;

  # now at last we do have to rebalance at nodes[q] because the tree has
  # gotten out of balance:
  p := AVLRebalance(tree,nodes[q]);
  p := p.newroot;

  # finishing touch: link new root of subtree (p) to t:
  if q = 1 then  # q resp. r was First node
    tree![6] := p;
  elif path[q-1] = -1 then
    AVLSetLeft(tree,nodes[q-1],p);
  else
    AVLSetRight(tree,nodes[q-1],p);
  fi;

  return true;
end;
if IsBound(AVLAdd_C) then
    InstallGlobalFunction(AVLAdd, AVLAdd_C);
else
    InstallGlobalFunction(AVLAdd, AVLAdd_GAP);
fi;

AVLIndexAdd_GAP := function(tree,data,value,index)
  # Parameters: index, data, value, tree
  #  tree is a AVL
  #  data is a data structure defined by the user
  #  value is the value to be stored under key data, nothing is stored if true
  #  index is the index, where data should be inserted in tree 1 ist at
  #          first position, NumberOfNodes+1 after the last.
  # Tries to add the data as a node in tree. Returns true if everything
  # went well or fail, if something went wrong,

  local p, path, nodes, n, q, offset, c, l, i;

  if index < 1 or index > tree![3]+1 then
    return fail;
  fi;

  p := tree![6];
  if p = 0 then   # A new, single node in the tree
    # index must be equal to 1
    tree![6] := AVLNewNode(tree);
    AVLSetLeft(tree,tree![6],0);
    AVLSetRight(tree,tree![6],0);
    AVLSetBalFactor(tree,tree![6],0);
    AVLSetRank(tree,tree![6],1);
    AVLSetData(tree,tree![6],data);
    if value <> true then
        AVLSetValue(tree,tree![6],value);
    fi;
    tree![3] := 1;
    return true;
  fi;

  # let's first find the right position in the tree:
  # but: remember the last node on the way with bal. factor <> 0 and the path
  #      after this node
  # and: remember the nodes where the Rank entry is incremented in case we
  #      find an "equal" element
  path := EmptyPlist(10);     # here all steps are recorded: -1:left, +1:right
  nodes := EmptyPlist(10);
  nodes[1] := p;   # here we store all nodes on our way, nodes[i+1] is reached
                   # from nodes[i] by walking one step path[i]
  n := 1;          # this is the length of "nodes"
  q := 0;          # this is the last node with bal. factor <> 0
                   # index in "nodes" or 0 for no such node
  offset := 0;     # number of nodes with smaller index than those in subtree
  repeat

    # do we have to remember this position?
    if AVLBalFactor(tree,p) <> 0 then
      q := n;       # forget old last node with balance factor <> 0
    fi;

    # now one step:
    if index <= offset+AVLRank(tree,p) then
      c := -1;    # we have to descend to left subtree
    else
      c := +1;    # we have to descend to right subtree
    fi;

    l := p;     # remember last position
    if c < 0 then   # data < AVLData(tree,p)
      AVLSetRank(tree,p,AVLRank(tree,p) + 1);
      p := AVLLeft(tree,p);
    else            # data > AVLData(tree,p)
      offset := offset + AVLRank(tree,p);
      p := AVLRight(tree,p);
    fi;
    Add(nodes,p);
    n := n + 1;
    Add(path,c);

  until p = 0;
  # now p is 0 and nodes[n-1] is the node where data must be attached
  # the tree must be modified between nodes[q] and nodes[n-1] along path
  # Ranks are already done
  l := nodes[n-1];   # for easier reference

  # a new node:
  p := AVLNewNode(tree);
  AVLSetLeft(tree,p,0);
  AVLSetRight(tree,p,0);
  AVLSetBalFactor(tree,p,0);
  AVLSetRank(tree,p,1);
  AVLSetData(tree,p,data);
  if value <> true then
      AVLSetValue(tree,p,value);
  fi;
  # insert into tree:
  if c < 0 then    # left
    AVLSetLeft(tree,l,p);
  else
    AVLSetRight(tree,l,p);
  fi;
  tree![3] := tree![3] + 1;

  # modify balance factors between q and l:
  for i in [q+1..n-1] do
    AVLSetBalFactor(tree,nodes[i],path[i]);
  od;

  # is rebalancing at q necessary?
  if q = 0 then    # whole tree has grown one step
    return true;   # Success!
  fi;
  if AVLBalFactor(tree,nodes[q]) = -path[q] then
    # the subtree at q has gotten more balanced
    AVLSetBalFactor(tree,nodes[q],0);
    return true;   # Success!
  fi;

  # now at last we do have to rebalance at nodes[q] because the tree has
  # gotten out of balance:
  p := AVLRebalance(tree,nodes[q]);
  p := p.newroot;

  # finishing touch: link new root of subtree (p) to t:
  if q = 1 then  # q resp. r was First node
    tree![6] := p;
  elif path[q-1] = -1 then
    AVLSetLeft(tree,nodes[q-1],p);
  else
    AVLSetRight(tree,nodes[q-1],p);
  fi;

  return true;
end;
if IsBound(AVLIndexAdd_C) then
    InstallGlobalFunction(AVLIndexAdd, AVLIndexAdd_C);
else
    InstallGlobalFunction(AVLIndexAdd, AVLIndexAdd_GAP);
fi;

AVLDelete_GAP := function(tree,data)
  # Parameters: tree, data
  #  tree is a AVL
  #  data is a data structure defined by the user
  # Tries to find data as a node in the tree. If found, this node is deleted
  # and the tree rebalanced. It is an error, if the node is not found.
  # Returns fail in this case, and the stored value normally.
  local compare, p, path, nodes, n, ranksubs, c, m, l, r, i, old;

  compare := tree![5];

  p := tree![6];
  if p = 0 then   # Nothing to delete or find
    return fail;
  fi;
  if tree![3] = 1 then
    if compare(data,AVLData(tree,p)) = 0 then
      tree![3] := 0;
      tree![6] := 0;
      return AVLFreeNode(tree,p);
    else
      return fail;
    fi;
  fi;

  # let's first find the right position in the tree:
  # and: remember the nodes where the Rank entry is decremented in case we
  #      find an "equal" element
  path := EmptyPlist(10);    # here all steps are recorded: -1:left, +1:right
  nodes := EmptyPlist(10);
  nodes[1] := p;   # here we store all nodes on our way, nodes[i+1] is reached
                   # from nodes[i] by walking one step path[i]
  n := 1;          # this is the length of "nodes"
  ranksubs := EmptyPlist(10);# nothing done so far, list of Rank-modified nodes

  repeat

    # what is the next step?
    c := compare(data,AVLData(tree,p));

    if c <> 0 then  # only if data not found!
      if c < 0 then       # data < AVLData(tree,p)
        AVLSetRank(tree,p,AVLRank(tree,p) - 1);
        Add(ranksubs,p);
        p := AVLLeft(tree,p);
      elif c > 0 then     # data > AVLData(tree,p)
        p := AVLRight(tree,p);
      fi;
      Add(nodes,p);
      n := n + 1;
      Add(path,c);
    fi;

    if p = 0 then
      # error, we did not find data
      for i in ranksubs do
        AVLSetRank(tree,i,AVLRank(tree,i) + 1);
      od;
      return fail;
    fi;

  until c = 0;   # until we find the right node
  # now data is equal to AVLData(tree,p,) so this node p must be removed.
  # the tree must be modified between tree![6] and nodes[n] along path
  # Ranks are already done up there

  # now we have to search a neighbour, we modify "nodes" and "path" but not n!
  m := n;
  if AVLBalFactor(tree,p) < 0 then   # search to the left
    l := AVLLeft(tree,p);   # must be a node!
    AVLSetRank(tree,p,AVLRank(tree,p) - 1);
    # we will delete in left subtree!
    Add(nodes,l);
    m := m + 1;
    Add(path,-1);
    while AVLRight(tree,l) <> 0 do
      l := AVLRight(tree,l);
      Add(nodes,l);
      m := m + 1;
      Add(path,1);
    od;
    c := -1;       # we got predecessor
  elif AVLBalFactor(tree,p) > 0 then    # search to the right
    l := AVLRight(tree,p);  # must be a node!
    Add(nodes,l);
    m := m + 1;
    Add(path,1);
    while AVLLeft(tree,l) <> 0 do
      AVLSetRank(tree,l,AVLRank(tree,l) - 1);
      # we will delete in left subtree!
      l := AVLLeft(tree,l);
      Add(nodes,l);
      m := m + 1;
      Add(path,-1);
    od;
    c := 1;        # we got successor
  else   # equal depths
    if AVLLeft(tree,p) <> 0 then
      l := AVLLeft(tree,p);
      AVLSetRank(tree,p,AVLRank(tree,p) - 1);
      Add(nodes,l);
      m := m + 1;
      Add(path,-1);
      while AVLRight(tree,l) <> 0 do
        l := AVLRight(tree,l);
        Add(nodes,l);
        m := m + 1;
        Add(path,1);
      od;
      c := -1;     # we got predecessor
    else           # we got an end node
      l := p;
      c := 0;
    fi;
  fi;
  # l points now to a neighbour, in case c = -1 to the predecessor, in case
  # c = 1 to the successor, or to p itself in case c = 0
  # "nodes" and "path" is updated, but n could be < m

  # Copy Data from l up to p: order is NOT modified
  AVLSetData(tree,p,AVLData(tree,l));
     # works for m = n, i.e. if p is end node

  # Delete node at l = nodes[m] by modifying nodes[m-1]:
  # Note: nodes[m] has maximal one subtree!
  if c <= 0 then
    r := AVLLeft(tree,l);
  else  #  c > 0
    r := AVLRight(tree,l);
  fi;
  if path[m-1] < 0 then
    AVLSetLeft(tree,nodes[m-1],r);
  else
    AVLSetRight(tree,nodes[m-1],r);
  fi;
  tree![3] := tree![3] - 1;
  old := AVLFreeNode(tree,l);

  # modify balance factors:
  # the subtree nodes[m-1] has become shorter at its left (resp. right)
  # subtree, if path[m-1]=-1 (resp. +1). We have to react according to
  # the BalFactor at this node and then up the tree, if the whole subtree
  # has shrunk:
  # (we decrement m and work until the corresponding subtree has not shrunk)
  m := m - 1;  # start work HERE
  while m >= 1 do
    if AVLBalFactor(tree,nodes[m]) = 0 then
      AVLSetBalFactor(tree,nodes[m],-path[m]);  # we made path[m] shorter
      return old;
    elif AVLBalFactor(tree,nodes[m]) = path[m] then
      AVLSetBalFactor(tree,nodes[m],0);         # we made path[m] shorter
    else    # tree is out of balance
      p := AVLRebalance(tree,nodes[m]);
      if m = 1 then
        tree![6] := p.newroot;
        return old;               # everything is done
      elif path[m-1] = -1 then
        AVLSetLeft(tree,nodes[m-1],p.newroot);
      else
        AVLSetRight(tree,nodes[m-1],p.newroot);
      fi;
      if not p.shorter then return old; fi;   # nothing happens further up
    fi;
    m := m - 1;
  od;
  return old;
end;
if IsBound(AVLDelete_C) then
    InstallGlobalFunction(AVLDelete, AVLDelete_C);
else
    InstallGlobalFunction(AVLDelete, AVLDelete_GAP);
fi;

AVLIndexDelete_GAP := function(tree,index)
  # Parameters: tree, index
  #  index is the index of the element to be deleted, must be between 1 and
  #          tree![3] inclusively
  #  tree is a AVL
  # returns fail if index is out of range, otherwise the deleted key;
  local p, path, nodes, n, offset, c, m, l, r, x;

  if index < 1 or index > tree![3] then
    return fail;
  fi;

  p := tree![6];
  if p = 0 then   # Nothing to delete or find
    return fail;
  fi;
  if tree![3] = 1 then
    # index must be equal to 1
    x := AVLData(tree,tree![6]);
    tree![3] := 0;
    tree![6] := 0;
    AVLFreeNode(tree,p);
    return x;
  fi;

  # let's first find the right position in the tree:
  path := EmptyPlist(10);     # here all steps are recorded: -1:left, +1:right
  nodes := EmptyPlist(10);
  nodes[1] := p;   # here we store all nodes on our way, nodes[i+1] is reached
                   # from nodes[i] by walking one step path[i]
  n := 1;          # this is the length of "nodes"
  offset := 0;     # number of "smaller" nodes than subtree in whole tree

  repeat

    # what is the next step?
    if index = offset+AVLRank(tree,p) then
      c := 0;   # we found our node!
      x := AVLData(tree,p);
    elif index < offset+AVLRank(tree,p) then
      c := -1;  # we have to go left
    else
      c := +1;  # we have to go right
    fi;

    if c <> 0 then  # only if data not found!
      if c < 0 then       # data < AVLData(tree,p)
        AVLSetRank(tree,p,AVLRank(tree,p) - 1);
        p := AVLLeft(tree,p);
      elif c > 0 then     # data > AVLData(tree,p)
        offset := offset + AVLRank(tree,p);
        p := AVLRight(tree,p);
      fi;
      Add(nodes,p);
      n := n + 1;
      Add(path,c);
    fi;

  until c = 0;   # until we find the right node
  # now index is right, so this node p must be removed.
  # the tree must be modified between tree.First and nodes[n] along path
  # Ranks are already done up there

  # now we have to search a neighbour, we modify "nodes" and "path" but not n!
  m := n;
  if AVLBalFactor(tree,p) < 0 then   # search to the left
    l := AVLLeft(tree,p);   # must be a node!
    AVLSetRank(tree,p,AVLRank(tree,p) - 1);
    # we will delete in left subtree!
    Add(nodes,l);
    m := m + 1;
    Add(path,-1);
    while AVLRight(tree,l) <> 0 do
      l := AVLRight(tree,l);
      Add(nodes,l);
      m := m + 1;
      Add(path,1);
    od;
    c := -1;       # we got predecessor
  elif AVLBalFactor(tree,p) > 0 then    # search to the right
    l := AVLRight(tree,p);  # must be a node!
    Add(nodes,l);
    m := m + 1;
    Add(path,1);
    while AVLLeft(tree,l) <> 0 do
      AVLSetRank(tree,l,AVLRank(tree,l) - 1);
      # we will delete in left subtree!
      l := AVLLeft(tree,l);
      Add(nodes,l);
      m := m + 1;
      Add(path,-1);
    od;
    c := 1;        # we got successor
  else   # equal depths
    if AVLLeft(tree,p) <> 0 then
      l := AVLLeft(tree,p);
      AVLSetRank(tree,p,AVLRank(tree,p) - 1);
      # we will delete in left subtree!
      Add(nodes,l);
      m := m + 1;
      Add(path,-1);
      while AVLRight(tree,l) <> 0 do
        l := AVLRight(tree,l);
        Add(nodes,l);
        m := m + 1;
        Add(path,1);
      od;
      c := -1;     # we got predecessor
    else           # we got an end node
      l := p;
      c := 0;
    fi;
  fi;
  # l points now to a neighbour, in case c = -1 to the predecessor, in case
  # c = 1 to the successor, or to p itself in case c = 0
  # "nodes" and "path" is updated, but n could be < m

  # Copy Data from l up to p: order is NOT modified
  AVLSetData(tree,p,AVLData(tree,l));
  # works for m = n, i.e. if p is end node

  # Delete node at l = nodes[m] by modifying nodes[m-1]:
  # Note: nodes[m] has maximal one subtree!
  if c <= 0 then
    r := AVLLeft(tree,l);
  else  #  c > 0
    r := AVLRight(tree,l);
  fi;
  if path[m-1] < 0 then
    AVLSetLeft(tree,nodes[m-1],r);
  else
    AVLSetRight(tree,nodes[m-1],r);
  fi;
  tree![3] := tree![3] - 1;
  AVLFreeNode(tree,l);

  # modify balance factors:
  # the subtree nodes[m-1] has become shorter at its left (resp. right)
  # subtree, if path[m-1]=-1 (resp. +1). We have to react according to
  # the BalFactor at this node and then up the tree, if the whole subtree
  # has shrunk:
  # (we decrement m and work until the corresponding subtree has not shrunk)
  m := m - 1;  # start work HERE
  while m >= 1 do
    if AVLBalFactor(tree,nodes[m]) = 0 then
      AVLSetBalFactor(tree,nodes[m],-path[m]);  # we made path[m] shorter
      return x;
    elif AVLBalFactor(tree,nodes[m]) = path[m] then
      AVLSetBalFactor(tree,nodes[m],0);         # we made path[m] shorter
    else    # tree is out of balance
      p := AVLRebalance(tree,nodes[m]);
      if m = 1 then
        tree![6] := p.newroot;
        return x;               # everything is done
      elif path[m-1] = -1 then
        AVLSetLeft(tree,nodes[m-1],p.newroot);
      else
        AVLSetRight(tree,nodes[m-1],p.newroot);
      fi;
      if not p.shorter then return x; fi;   # nothing happens further up
    fi;
    m := m - 1;
  od;
  return x;
end;
if IsBound(AVLIndexDelete_C) then
    InstallGlobalFunction(AVLIndexDelete, AVLIndexDelete_C);
else
    InstallGlobalFunction(AVLIndexDelete, AVLIndexDelete_GAP);
fi;

AVLToList_GAP := function(tree)
  # walks recursively through the tree and builds a list, where every entry
  # belongs to a node in the order of the tree and each entry is a list,
  # containing the data as first entry, the depth in the tree as second
  # and the balance factor as third. Mainly for test purposes.

  local l, DoRecursion;

  l := EmptyPlist(tree![3]);

  DoRecursion := function(p,depth)
    # does the work
    if AVLLeft(tree,p) <> 0 then
      DoRecursion(AVLLeft(tree,p),depth+1);
    fi;
    Add(l,[AVLData(tree,p),depth,AVLBalFactor(tree,p)]);
    if AVLRight(tree,p) <> 0 then
      DoRecursion(AVLRight(tree,p),depth+1);
    fi;
  end;

  DoRecursion(tree![6],1);
  return l;
end;
if IsBound(AVLToList_C) then
    InstallGlobalFunction(AVLToList, AVLToList_C);
else
    InstallGlobalFunction(AVLToList, AVLToList_GAP);
fi;

BindGlobal( "AVLTest", function(tree)
  # walks recursively through the tree and tests its balancedness. Returns
  # the depth or the subtree where the tree is not balanced. Mainly for test
  # purposes. Returns tree if the NumberOfNodes is not correct.

  local error, DoRecursion, depth;

  error := false;

  DoRecursion := function(p)
    # does the work, returns false, if an error is detected in the subtree
    # and a list with the depth of the tree and the number of nodes in it.
    local ldepth, rdepth;

    if AVLLeft(tree,p) <> 0 then
      ldepth := DoRecursion(AVLLeft(tree,p));
      if ldepth = false then
        return false;
      fi;
    else
      ldepth := [0,0];
    fi;
    if AVLRight(tree,p) <> 0 then
      rdepth := DoRecursion(AVLRight(tree,p));
      if rdepth = false then
        return false;
      fi;
    else
      rdepth := [0,0];
    fi;
    if AbsInt(rdepth[1]-ldepth[1]) > 1 or
       AVLBalFactor(tree,p) <> rdepth[1]-ldepth[1] or
       AVLRank(tree,p) <> ldepth[2] + 1 then
      error := p;
      return false;
    else
      return [Maximum(ldepth[1],rdepth[1])+1,ldepth[2]+rdepth[2]+1];
    fi;
  end;

  if tree![6] = 0 then
    return rec( depth := 0, ok := true );
  else
    depth := DoRecursion(tree![6]);
    if depth = false then
      return rec( badsubtree := error, ok := false );
                                # set from within DoRecursion
    else
      if depth[2] = tree![3] then
        return rec( depth := depth[1], ok := true );
                    # Number of Nodes is correct!
      else
        return rec( badsubtree := tree![6], ok := false);
      fi;
    fi;
  fi;
end);

AVLFindIndex_GAP := function(tree,data)
  # Parameters: tree, data
  #  t is a AVL
  #  data is a data structure defined by the user
  # Searches in tree for a node equal to data, returns its index or fail
  # if not found.
  local compare, p, c, index;
  compare := tree![5];
  p := tree![6];
  index := 0;
  while p >= 8 do
    c := compare(data,AVLData(tree,p));
    if c = 0 then
      return index + AVLRank(tree,p);
    elif c < 0 then    # data < AVLData(tree,p)
      p := AVLLeft(tree,p);
    else               # data > AVLData(tree,p)
      index := index + AVLRank(tree,p);
      p := AVLRight(tree,p);
    fi;
  od;
  return fail;
end ;
if IsBound(AVLFindIndex_C) then
    InstallGlobalFunction(AVLFindIndex, AVLFindIndex_C);
else
    InstallGlobalFunction(AVLFindIndex, AVLFindIndex_GAP);
fi;

InstallOtherMethod( ELM_LIST, "for an avl tree and an index",
  [ IsAVLTree and IsAVLTreeFlatRep, IsPosInt ],
  AVLIndex );

InstallOtherMethod( Position, "for an avl tree, an object, and an index",
  [ IsAVLTree and IsAVLTreeFlatRep, IsObject, IsInt ],
  function( t, x, pos )
    local i,j;
    i := AVLFindIndex(t,x);
    if i = fail or i <= pos then
        return fail;
    else
        return i;
    fi;
  end);

InstallOtherMethod( Remove, "for an avl tree and an index",
  [ IsAVLTree and IsAVLTreeFlatRep and IsMutable, IsPosInt ],
  AVLIndexDelete );

InstallOtherMethod( Remove, "for an avl tree",
  [ IsAVLTree and IsAVLTreeFlatRep and IsMutable ],
  function( t )
    return AVLIndexDelete(t,t![3]);
  end );

InstallOtherMethod( Length, "for an avl tree",
  [ IsAVLTree and IsAVLTreeFlatRep ],
  function( t )
    return t![3];
  end );

InstallOtherMethod( ADD_LIST, "for an avl tree and an object",
  [ IsAVLTree and IsAVLTreeFlatRep and IsMutable, IsObject ],
  function( t, x )
    AVLIndexAdd(t,x,true,t![3]+1);
  end );

InstallOtherMethod( ADD_LIST, "for an avl tree, an object and a position",
  [ IsAVLTree and IsAVLTreeFlatRep and IsMutable, IsObject, IsPosInt ],
  function( t, x, pos )
    AVLIndexAdd(t,x,true,pos);
  end );

InstallOtherMethod( IN, "for an object and an avl tree",
  [ IsObject, IsAVLTree and IsAVLTreeFlatRep ],
  function( x, t )
    return AVLFind(t,x) <> fail;
  end );


##
##  This program is free software: you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation, either version 3 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program.  If not, see <https://www.gnu.org/licenses/>.
##

Quelle avltree.gi Sprache: unbekannt

[ Dauer der Verarbeitung: 0.52 Sekunden (vorverarbeitet) ]