------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  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 Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- BTREES, also called (a,b)-trees are gerneralized avl-trees
-- 22.3.1995 Holger Klawitter <holger@math.uni-muenster.de>
-- Defined classes:
--   B_TREE{KEY,ELT}
-- Helper classes:
--   B_TREE{KEY,ELT,NODE}
--   BT_NODE{KEY,ELT}
--   BT_NELEM{KEY,ELT,NODE}
---------------------------------------------------------------------
class B_TREE{KEY<$IS_LT{KEY},ELT}
-- The standard version of the b-tree
-- B-trees, also called (a,b) trees are generalized avl-trees
-- i.e. balanced trees that provide fast access to elements based
-- on an index. B_TREES can be used as an alternative of
-- *MAPs. They are optimized for usage in environment with slow
-- access to elt.  
is
   include B_TREE{KEY,ELT,BT_NODE{KEY,ELT}};
end; -- class B_TREE
----------------------------------------------------------------------
class B_TREE{KEY<$IS_LT{KEY},ELT,NODE<$BT_NODE{KEY,ELT,NODE}} < $MAP{KEY,ELT}
-- The more general version of the Btree class which permits the user
-- to provide his own node type (NODE) that provides the access and
-- information functions needed. This class then maintains the tree
-- invariant.  In general, you can use the B_TREE class with two
-- parameters and not be concerned with the NODE type (use the BT_NODE
-- standard node type) B_TREES can be used as an alternative of
-- *MAPs. They are optimized for usage in environment with slow access
-- to elt.
is

   include MAP_INCL{KEY,ELT};
	 
   private attr root: NODE;

   readonly attr size: INT;
   
   create: SAME is return new end;
   
   aset(k: KEY, d: ELT)
   -- Associate d with k and store it in the btree.
   -- If this key already exists in the btree the data will
   -- be overwritten. Association void to the key is
   -- equivalent to delete the key with its data.
      pre ~void(self)
   is
      node,e: NODE;
      pos: INT;
      found: BOOL;
      
      stack ::= #A_STACK{TUP{INT,NODE}};
      item ::= #TUP{KEY,ELT}(k, d);
      if void(root) then
	 root := #NODE(item);
	 size := 1;
	 return
      end;
      
      found := root.find(k, stack);
      node := stack.top.t2;
      pos := stack.pop.t1;
      if found then
	 node.setItem(pos, item)
      else
	 size := size + 1;
	 e := #NODE(item);
	 loop
	    if node.size < node.maxSize then
	       node.nodeInsert(e, pos);
	       break!
	    elsif node = root then
	       root := node.split(e, pos);
	       break!
	    elsif node.rightFree(stack) then
	       node.pushRight(e, pos, stack);
	       break!
	    elsif node.leftFree(stack) then
	       node.pushLeft(e, pos, stack);
	       break!
	    end;
	    e := node.split(e, pos);
	    node := stack.top.t2;
	    pos := stack.pop.t1
	 end
      end
   end; -- aset

   insert(t:TUP{KEY,ELT}):SAME is
      res ::= copy; res[t.t1] := t.t2; return res;
   end;
      
   aget(k: KEY): ELT
	 pre ~void(self)
   is
      stack ::= #A_STACK{TUP{INT,NODE}};
      if root.find(k,stack) then
	 return stack.top.t2[stack.top.t1].item.t2;
      else
	 return void
      end;
   end; -- aget
   
   delete(k: KEY)
   -- Remove the key and its associated elt from the btree.
      pre ~void(self)
   is
      dummy ::= delete(k)
   end;
   
   delete(k: KEY): ELT
   -- Removes the key and its associated elt from the btree.
   -- Returns the element being deleted or void if none found.
      pre ~void(self)
   is
      node,delNode: NODE;
      pos, delPos: INT;
      found: BOOL;

      if void(root) then return void end;
      stack ::= #A_STACK{TUP{INT,NODE}};
      found := root.find(k, stack);
      if ~found then return void end;

      size := size - 1;
      delNode := stack.top.t2;
      delPos := stack.top.t1;
      res ::= delNode[delPos].item.t2;
      
      if ~void(delNode[delPos].node) then -- not a true leaf
	 delNode.findPred(stack);
	 node := stack.top.t2;
	 pos := stack.pop.t1 - 1;
	 delNode.setItem(delPos, node[pos].item)
      else
	 node := delNode;
	 pos := stack.pop.t1
	 -- same as delPos, but I want to pop the stack
      end;
      loop
	 if node = root then
	    node.nodeDelete(pos);
	    if node.size = 0 then
	       root := node[0].node
	    end;
	    break!
	 elsif node.size > node.minSize then
	    node.nodeDelete(pos);
	    break!
	 elsif node.leftSpare(stack) then
	    node.pullLeft(pos, stack);
	    break!
	 elsif node.rightSpare(stack) then
	    node.pullRight(pos, stack);
	    break!
	 end;
	 if stack.top.t1 < stack.top.t2.size then
	    node.joinRight(pos, stack)
	 else
	    node.joinLeft(pos, stack)
	 end;
	 node := stack.top.t2;
	 pos := stack.pop.t1
      end;
      return res
   end; -- delete

   has_ind(k: KEY): BOOL
   -- Answer 'true' if such a key exists within the btree.
      pre ~void(self)
   is
      if void(root) then return false end;
      stack ::= #A_STACK{TUP{INT,NODE}};
      res ::= root.find(k, stack);
      return res
   end; -- has_ind

   has(e: TUP{KEY,ELT}): BOOL is 
      if has_ind(e.t1) then 
	 return ELT_EQ{ELT}::elt_eq(aget(e.t1),e.t2) 
      else return false; end;
   end;
   
   has_target(e: ELT): BOOL
      pre ~void(self)
   is
      loop
	 other ::= root.elt!;
	 if ELT_EQ{ELT}::elt_eq(e,other) then return true end;
      end;
      return false
   end; -- has_elt

   str: STR is return ELT_ALG{TUP{KEY,ELT}}::str(self) end;
   
   copy: SAME
   is
      res ::= #SAME;
      loop
	 pair ::= pair!;
	 res[pair.t1] := pair.t2
      end;
      return res
   end; -- copy
	    
   ind!: KEY
   -- Yield all keys in-order.
      pre ~void(self)
   is
      loop yield root.ind! end
   end;
   
   target!: ELT
   -- Yield all elt in order of the keys.
      pre ~void(self)
   is
      loop yield root.elt! end
   end;
   
   elt!: TUP{KEY,ELT} pre ~void(self) is
      -- Yield all pairs of key and elt in the order of the keys.
      loop yield elt!; end;
   end;
   
   pair!: TUP{KEY,ELT}
   -- Yield all pairs of key and elt in the order of the keys.
      pre ~void(self)
   is
      loop yield root.pair! end
   end;
   
end; -- class B_TREE
---------------------------------------------------------------------
abstract class $BT_NODE{KEY<$IS_LT{KEY},ELT,NODE < $BT_NODE{KEY,ELT,NODE} }
-- Abstraction for a node in a BTREE
is
    create: SAME;
    create(t:TUP{KEY,ELT}): SAME;
    
    is_eq(n:NODE): BOOL;
    aget(i:INT): BT_NELEM{KEY,ELT,NODE};
    size: INT;
    minSize: INT;
    maxSize: INT;
        
    setItem(pos:INT,t:TUP{KEY,ELT});
    setNode(pos:INT,node:NODE);
    
    leftFree(stack:A_STACK{TUP{INT,NODE}}): BOOL;
    rightFree(stack:A_STACK{TUP{INT,NODE}}): BOOL;
    leftSpare(stack:A_STACK{TUP{INT,NODE}}): BOOL;
    rightSpare(stack:A_STACK{TUP{INT,NODE}}): BOOL;
    
    pushLeft(e:NODE,pos:INT,stack:A_STACK{TUP{INT,NODE}});
    pushRight(e:NODE,pos:INT,stack:A_STACK{TUP{INT,NODE}});
    split(e:NODE,pos:INT): NODE;
    nodeInsert(n:NODE,pos:INT);
    
    pullLeft(pos:INT,stack:A_STACK{TUP{INT,NODE}});
    pullRight(pos:INT,stack:A_STACK{TUP{INT,NODE}});
    joinLeft(pos:INT,stack:A_STACK{TUP{INT,NODE}});
    joinRight(pos:INT,stack:A_STACK{TUP{INT,NODE}});
    nodeDelete(pos:INT);
    
    findPred(stack:A_STACK{TUP{INT,NODE}});
    find(k:KEY,stack:A_STACK{TUP{INT,NODE}}): BOOL;
    
    ind!: KEY;
    elt!: ELT;
    pair!: TUP{KEY,ELT};
    
end;
----------------------------------------------------------------------
class BT_NODE{KEY<$IS_LT{KEY},ELT } < $BT_NODE{KEY,ELT,BT_NODE{KEY,ELT}}
-- This class is inernally used by B_TREE.
-- It represents the root and all nodes in a B_BTEE.
-- The general structure of a BT_NODE is as follows:
--     [0].node [0].item [1].node [1].item ... [k].node [k].item [k+1].node
--     ([k+1].item is always unused)
is   
      --include COMPARABLE;
    include AREF{BT_NELEM{KEY,ELT,SAME}} aset->private aset;
    -- Array of items and nodes.
   
    attr size: INT;
   -- Current fill ratio of the node.
   
   const maxSize: INT := 4;
   -- maximal number of elt tuples.
   -- MUST BE EVEN AND GREATER THAN 2.
   
   const minSize: INT := maxSize / 2;
   
   create: SAME is return new(maxSize+1); end;
   
   create(t: TUP{KEY,ELT}): SAME
   is
      res ::= new(maxSize+1);
      res.setItem(0, t);
      res.size := 1;
      return res
   end; -- create
   
   is_eq(n: SAME): BOOL is return SYS::ob_eq(self,n) end;
   
   setItem(pos: INT, t: TUP{KEY,ELT})
      pre pos>=0 and pos<=maxSize
   is
      [pos] := [pos].item(t)
   end; -- setItem
   
   setNode(pos: INT, node: SAME)
      pre pos>=0 and pos<=maxSize
   is
      [pos] := [pos].node(node)
   end; -- setNode

   -- Predicates for sibling nodes
   
   leftFree(stack: A_STACK{TUP{INT,SAME}}): BOOL
      pre ~void(stack.top) and stack.top.t2 /= self
   is
      parent ::= stack.top;
      return parent.t1 > 0
	    and parent.t2[parent.t1-1].node.size < maxSize
   end; -- leftFree
   
   rightFree(stack: A_STACK{TUP{INT,SAME}}): BOOL
      pre ~void(stack.top) and stack.top.t2 /= self
   is
      parent ::= stack.top;
      return parent.t1 < parent.t2.size
	    and parent.t2[parent.t1+1].node.size < maxSize
   end; -- rightFree
   
   leftSpare(stack: A_STACK{TUP{INT,SAME}}): BOOL
      pre ~void(stack.top) and stack.top.t2 /= self
   is
      parent ::= stack.top;
      return parent.t1 > 0
	    and parent.t2[parent.t1-1].node.size > minSize
   end; -- leftSpare
   
   rightSpare(stack: A_STACK{TUP{INT,SAME}}): BOOL
      pre ~void(stack.top) and stack.top.t2 /= self
   is
      parent ::= stack.top;
      return parent.t1 < parent.t2.size
	    and parent.t2[parent.t1+1].node.size > minSize
   end; -- rightSpare

   ------------ Insertion
   
   pushLeft(e: SAME, pos: INT, stack: A_STACK{TUP{INT,SAME}})
      pre size=maxSize
   is
      parent, left: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      left := parent[ppos-1].node;
      
      left.setItem(left.size, parent[ppos-1].item);
      if pos = 0 then -- item goes up
	 left.setNode(left.size+1, e[0].node);
	 parent.setItem(ppos-1, e[0].item);
	 setNode(0, e[1].node)
      else -- item[0] goes up, insert item
	 parent.setItem(ppos-1, [0].item);
	 left.setNode(left.size+1, [0].node);
	 loop i:= 0.upto!(pos-2);
	    [i] := [i+1]
	 end;
	 [pos-1] := e[0];
	 setNode(pos, e[1].node)
      end;
      left.size := left.size + 1
   end;
   
   pushRight(e: SAME, pos: INT, stack: A_STACK{TUP{INT,SAME}})
      pre size = maxSize
   is
      parent, right: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      right := parent[ppos+1].node;
      
      loop i:= right.size.downto!(0); -- create some space
	 right[i+1] := right[i]
      end;
      right.setItem(0, parent[ppos].item);
      if pos = size then -- item goes up
	 parent.setItem(ppos, e[0].item);
	 setNode(size, e[0].node);
	 right.setNode(0, e[1].node)
      else -- last item goes up, item will be inserted.
	 parent.setItem(ppos, [size-1].item);
	 right.setNode(0, [size].node);
	 setNode(size, [size-1].node);
	 loop i := (size-2).downto!(pos);
	    [i+1] := [i]
	 end;
	 [pos] := e[0];
	 setNode(pos+1, e[1].node)
      end;
      right.size := right.size + 1
   end;
   
   split(e: SAME, pos: INT): SAME
      pre size = maxSize
   is
      i: INT;
      newNode: SAME := #;
      if pos <= minSize then -- item does not go right
	 loop i := minSize.upto!(size);
	    newNode[i-minSize] := [i];
	    [i] := void
	 end;
	 if pos = minSize then -- item goes up
	    newNode.setNode(0, e[1].node);
	    setNode(minSize, e[0].node)
	 else -- item stays left
	    loop i := minSize.downto!(pos+1);
	       [i] := [i-1]
	    end;
	    [pos] := e[0];
	    setNode(pos+1, e[1].node);
	    e.setItem(0, [minSize].item);
	    setItem(minSize, void)
	 end;
      else -- item goes right
	 loop i := size.downto!(pos);
	    newNode[i-minSize] := [i];
	    [i] := void
	 end;
	 newNode.setNode(pos-minSize, e[1].node);
	 newNode[pos-minSize-1] := e[0];
	 loop i := (pos-1).downto!(minSize+1);
	    newNode[i-minSize-1] := [i];
	    [i] := void
	 end;
	 e.setItem(0, [minSize].item);
	 setItem(minSize, void)
      end;
      size := minSize;
      newNode.size := minSize;
      e.setNode(0, self); -- generate the new node to insert.
      e.setNode(1, newNode);
      assert e.size = 1;
      return e
   end;
   
   nodeInsert(n: SAME, pos: INT)
      pre pos>=0 and pos<=maxSize and size<maxSize
   is
      i: INT;
      loop i := size.downto!(pos);
	 [i+1] := [i]
      end;
      [pos] := n[0];
      setNode(pos+1, n[1].node);
      size := size + 1
   end;
   
   ------------ Deletion
   
   pullLeft(pos: INT, stack: A_STACK{TUP{INT,SAME}})
   is
      parent, left: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      left := parent[ppos-1].node;
      
      loop i := pos.downto!(1); -- Move hole to the left end.
	 [i] := [i-1]
      end;
      setItem(0, parent[ppos-1].item); -- get from parent
      setNode(0, left[size].node);
      parent.setItem(ppos-1, left[left.size-1].item); -- refill parent
      left[left.size] := void;
      left.setItem(left.size-1, void);
      left.size := left.size - 1
   end;
   
   pullRight(pos: INT, stack: A_STACK{TUP{INT,SAME}})
   is
      parent, right: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      right := parent[ppos+1].node;
      
      loop i := pos.upto!(size-1); -- Close hole.
	 [i] := [i+1]
      end;
      setItem(size-1, parent[ppos].item); -- Get right end from parent.
      setNode(size, right[0].node);
      parent.setItem(ppos, right[0].item);
      loop i := 1.upto!(right.size);
	 right[i-1] := right[i]
      end;
      right[right.size] := void; -- more efficient than 'just' setNode.
      right.size := right.size - 1
   end;
   
   joinLeft(pos: INT, stack: A_STACK{TUP{INT,SAME}})
      pre size = minSize
   is
      parent, left: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      left := parent[ppos-1].node;
      assert left.size = minSize;
      
      loop i := pos.downto!(1); -- Move hole to the left.
	 [i] := [i-1]
      end;
      setNode(0, left[left.size].node); -- Get from parent.
      setItem(0, parent[ppos-1].item);
      loop i := size.downto!(0); -- Make BIG hole for left sibling.
	 [i+minSize] := [i] -- means [i+left.size] := [i]
      end;
      loop i := 0.upto!(minSize-1);
	 [i] := left[i]
      end;
      parent.setNode(ppos-1, self);
      parent.setItem(ppos-1, parent[ppos].item);
      size := maxSize
   end;
   
   joinRight(pos: INT, stack: A_STACK{TUP{INT,SAME}})
      pre size = minSize
   is
      parent, right: SAME;
      i, ppos: INT;
      parent := stack.top.t2;
      ppos := stack.top.t1;
      right := parent[ppos+1].node;
      assert right.size = minSize;
      
      loop i := (pos+1).upto!(size); -- Close hole.
	 [i-1] := [i]
      end;
      setItem(size-1, parent[ppos].item); -- Get from parent.
      loop i := 0.upto!(right.size); -- Do joining.
	 [size+i] := right[i]
      end;
      parent.setNode(ppos+1, self);
      size := maxSize
   end;
   
   nodeDelete(pos: INT)
      pre pos>=0 and pos<=maxSize
   is
      i: INT;
      loop i := pos.upto!(size-1);
	 [i] := [i+1]
      end;
      [size] := void;
      size := size - 1
   end;
   
   findPred(stack: A_STACK{TUP{INT,SAME}})
   is
      node ::= stack.top.t2[stack.top.t1].node;
      loop until!(void(node));
	 stack.push(#TUP{INT,SAME}(node.size, node));
	 node := node[node.size].node
      end
   end;
   
   ------------ Retrieval
   
   find(k: KEY, stack: A_STACK{TUP{INT,SAME}}): BOOL
   is
      if void(self) then return false end;
      loop
	 i ::= 0.upto!(size-1);
	 if [i].item.t1 = k then
	    stack.push(#TUP{INT,SAME}(i,self));
	    return true
	 elsif k < [i].item.t1 then
	    stack.push(#TUP{INT,SAME}(i,self));
	    return ~void([i].node) and [i].node.find(k, stack)
	 end
      end;
      stack.push(#TUP{INT,SAME}(size,self));
      return ~void([size].node) and [size].node.find(k, stack)
   end;

   ------------ Iterators
   
   ind!: KEY
   is
      if ~void(self)
      then
	 loop
	    i ::= 0.upto!(size);
	    loop yield [i].node.ind! end;
	    if ~void([i].item) -- and i<size but this is redunant
	    then yield [i].item.t1
	    end
	 end
      end
   end;
   
   elt!: ELT
   is
      if ~void(self)
      then
	 loop
	    i ::= 0.upto!(size);
	    loop yield [i].node.elt! end;
	    if ~void([i].item) -- and i<size but this is redunant
	    then yield [i].item.t2
	    end
	 end
      end
   end;
   
   pair!: TUP{KEY,ELT}
   is
      if ~void(self)
      then
	 loop
	    i ::= 0.upto!(size);
	    loop yield [i].node.pair! end;
	    if ~void([i].item) -- and i<size but this is redunant
	    then yield [i].item
	    end
	 end
      end
   end;
   
end; -- class BT_NODE
----------------------------------------------------------------------
immutable class BT_NELEM{KEY<$IS_LT{KEY},ELT,NODE<$BT_NODE{KEY,ELT,NODE}}
-- BT_NELEM is being internally used by BT_NODE to store the
-- nodes and the items efficiently.
is
   attr node: NODE;
   attr item: TUP{ KEY, ELT };
   
   create(n: NODE, i: TUP{KEY,ELT}): SAME
   is
      return node(n).item(i)
   end;
end; -- class BT_NELEM
----------------------------------------------------------------------
