h_bag.sa

 
---------------------------> Sather 1.1 source file <--------------------------
-- h_bag.sa: Hash table based bag
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- $Id: h_bag.sa,v 1.5 1996/04/09 10:05:03 borisv Exp $
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.


class BAG{E} < $BAG{E} 
class BAG{E} < $BAG{E} is 
   -- A standard bag is an alias for an H_BAG{E}. See the ancestors
   -- 
   -- Usage:
   --   b ::= #BAG{INT}(|10,10,11|);
   --   a: INT := 0;
   --   loop a := a+b.elt!; end;     -- adds the bag elemetns in some 
   --                                -- undefined order. 
   --   

   include H_BAG{E} 
end;


class H_BAG{E} < $BAG{E} 
class H_BAG{E} < $BAG{E} is
   -- This Bag sorts its elements by counting the number of occurences.
   -- If two _different but equal_ elements are inserted only one of
   -- them will be stored, but this one will be yielded twice.
   -- 
   private include DYNAMIC_DATABUCKET_TABLE{E,INT}
	 create->private old_create, 
	 map_aget->private aget,map_aset->private aset,
	 map_key!->unique!;       -- Make the key routine public
   include BAG_INCL{E};

   private attr total_size: INT;
   
   --              ------ Initialization/Duplication ------
   private internal_create: SAME is
      -- Redefine the stub routine in "BAG_INCL"
      return create;
   end;
   
   create: SAME is
      return old_create
   end;

   create(e: $ELT{E}): SAME is
      res: SAME := #;
      loop res.insert(e.elt!) end;
      return res;
   end;

   create_from(a: ARRAY{E}): SAME is
      -- Create a bag from the elements of array "a".
      return #SAME(a);
   end;
   
   copy: SAME  pre ~void(self) is
      res ::= map_copy;
      res.total_size := total_size;
      return res
   end;

   -- ------------------- Access  -------------------------
   n_unique: INT is return n_inds end;
   -- Return the number of unique indicies
   
   count(e:E): INT  pre ~void(self) is
      -- Return the number of occurences of element "e"
      loop
	 b ::= bucket(hash(e)).list!;
	 if elt_eq(b.item,e) then return b.data end
      end;
      return 0
   end;

   has(e:E): BOOL pre ~void(self) is
      return count(e) > 0
   end;

   insert(e:E)  pre ~void(self) is
      h ::= hash(e);
      loop
	 b ::= bucket(h).list!;
	 if elt_eq(e,b.item) then
	    b.data := b.data + 1;
	    total_size := total_size + 1;
	    return
	 end
      end;
      set_bucket(h,#DATABUCKET{E,INT}(e,1,bucket(h)));
      -- TODO: optimize the bucket(h)

      total_size := total_size + 1;
      n_inds := n_inds + 1;
      update_insert
   end;

   delete(e:E) pre ~void(self) is
      dummy ::= delete(e)
   end;

   delete(e:E): E   pre ~void(self) is
      h ::= hash(e);
      b ::= bucket(h);
      prev ::= b; prev := void;	-- NASTY HACK
      if void(b) then return void end;
      loop until!( void(b) );
	 res ::= b.item;
	 if elt_eq(res,e) then
	    total_size := total_size - 1;
	    if b.data = 1 then
	       -- last occurrence removed
	       if void(prev) then
		  set_bucket(h,b.next)
	       else
		  prev.next(b.next)
	       end;
	       n_inds := n_inds - 1;
	       update_delete
	    else
	       b.data := b.data - 1
	    end;
	    return res
	 end;
	 prev := b;
	 b := b.next
      end;
      return void
   end;

   delete_all(e:E)   
   -- Delete all elements equal to "e"
      pre ~void(self) 
   is      
      dummy ::= delete_all(e)
   end;

   delete_all(e:E): INT   pre ~void(self) is
      anz ::= count(e);
      if anz = 0 then return 0 end;
      total_size := total_size - anz;
      return map_delete(e)
   end;

   elt!: E  pre ~void(self) is
      loop
	 b ::= bucket( 0.upto!(asize-1) );
	 loop
	    bk ::= b.list!;
	    loop bk.data.times!; yield bk.item end
	 end
      end
   end;

   intersection(a:$RO_BAG{E}): $BAG{E}
   -- The intersection of two bag has the element with the
   -- minimal occurence of both bags.
      pre ~void(self) and ~void(a)
   is
      res ::= create;
      loop
	 p ::= map_pair!;
	 acount ::= a.count(p.t1);
	 min ::= p.t2;
	 if acount < min then min := acount end;
	 if min > 0 then
	    res[p.t1] := min;
	    res.total_size := res.total_size + min
	 end
      end;
      return res
   end;

   difference(a:$RO_BAG{E}): $BAG{E}
   -- Returns a bag which represents the difference between self and "a"
      pre ~void(self) and ~void(a)
   is
      res ::= copy;
      loop res.delete(a.elt!) end;
      return res
   end;

end; -- H_BAG{E}