Jan 11 16:12 1996  open_hash_table.ads Page 1


-- Generic Package Specification for Open_Hash_Table
--     Implements a separate chaining table
-- Requires:
--     Instantiated with any private type and
--     a Hash function for that type and
--     a "=" function for that type
-- Types defined:
--     Hash_Position       private type
--     Hash_Table(Positive) limited private type
-- Exceptions defined:
--     Item_Not_Found      raised when searches or deletions fail
-- Operations defined:
--     (* throws Item_Not_Found)
--     Initialize and Finalize are defined
--     Find *              returns Tree_Ptr of item in search tree
--     Insert              add a new item into hash table
--     Make_Empty          make a hash tree empty
--     Retrieve *          returns item in Hash_Position passed as parameter
--
-- Note: my reading of the ARM implies that Hash_Table does not
--     need to be a Controlled type and that Initialize
--     and Finalize should be automatically called for the
--     linked lists. However, the compiler I am using (gnat 2.04)
--     disagrees with my interpretation. As a rsult, I am making
--     it a Controlled type, and defining Initialize and Finalize
--     for it.
--
-- Note: The Ada83 code propogated the List Item_Not_Found exception.
--     Although this seemed to work, I think the correct solution
--     is to convert List_Pack.Item_Not_Found to the Hash_Table
--     Item_Not_Found.

with Linked_Lists;
with Ada.Finalization;

generic
    type Element_Type is private;
    with function Hash( Key: Element_Type; Table_Size: Positive ) return Natural;
    with function "="( Left, Right: Element_Type ) return Boolean;
package Open_Hash_Table is

    type Hash_Position is private;
    type Hash_Table( H_Size: Positive ) is
                new Ada.Finalization.Limited_Controlled with private;

    procedure Finalize( H: in out Hash_Table );
    procedure Initialize( H: in out Hash_Table );

    function  Find( Key: Element_Type; H: Hash_Table ) return Hash_Position;
    procedure Make_Empty( H: in out Hash_Table );
    procedure Insert( Key: Element_Type; H: in out Hash_Table );
    function  Retrieve( P: Hash_Position ) return Element_Type;

    Item_Not_Found : exception;

private







Jan 11 16:12 1996  open_hash_table.ads Page 2


    package List_Pack is new Linked_Lists( Element_Type, "=" );

    type List_Array is array( Integer range <> ) of List_Pack.List;
    type Hash_Position is new List_Pack.Position;

    type Hash_Table( H_Size: Positive ) is
                    new Ada.Finalization.Limited_Controlled with
      record
        The_Lists : List_Array( 0..H_Size );
      end record;

end Open_Hash_Table;



















































Dec  9 12:02 1995  open_hash_table.adb Page 1


with Text_IO; use Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

package body Open_Hash_Table is

    procedure Initialize( H: in out Hash_Table ) is
    begin
        for I in H.The_Lists'range loop
            List_Pack.Initialize( H.The_Lists( i ) );
        end loop;
    end Initialize;

    procedure Finalize( H: in out Hash_Table ) is
    begin
        for I in H.The_Lists'range loop
            List_Pack.Finalize( H.The_Lists( i ) );
        end loop;
    end Finalize;

    -- Return Hash_Position of Key in Hash_Table H
    -- Item_Not_Found is thrown if appropriate
    function Find( Key: Element_Type; H: Hash_Table ) return Hash_Position is
        Hash_Val: Natural := Hash( Key, H.H_Size );
    begin
        return Hash_Position( List_Pack.Find( Key, H.The_Lists( Hash_Val ) ) );
    exception
        when List_Pack.Item_Not_Found => raise Item_Not_Found;
    end Find;

    -- Make an empty hash table
    procedure Make_Empty( H: in out Hash_Table ) is
    begin
        for I in H.The_Lists'range loop
            List_Pack.Make_Empty( H.The_Lists( I ) );
        end loop;
    end Make_Empty;

    -- Insert Key into Hash_Table H
    -- Do not insert duplicates
    procedure Insert( Key: Element_Type; H: in out Hash_Table ) is
        Hash_Val : Natural := Hash( Key, H.H_Size );
    begin
        if not List_Pack.In_List( Key, H.The_Lists( Hash_Val ) ) then
            List_Pack.Insert_As_First_Element( Key, H.The_Lists( Hash_Val ) );
        end if;
    end Insert;

    -- Return item in Hash_Position P
    function Retrieve( P: Hash_Position ) return Element_Type is
    begin
        return List_Pack.Retrieve( List_Pack.Position( P ) );
    exception
        when List_Pack.Item_Not_Found => raise Item_Not_Found;
    end Retrieve;

end Open_Hash_Table;







Dec  9 12:10 1995  open_hash_table_test.adb Page 1


-- A really puny test routine for Open_Hash_Table

with Open_Hash_Table;
with Ada.Text_IO; use Ada.Text_IO;

procedure Open_Hash_Table_Test is

    subtype My_String is String( 1..80 );
    function Hash( Key: String; Table_Size: Integer ) return  Natural;
    package Str_Hash is new Open_Hash_Table( My_String, Hash, "=" ); use Str_Hash;

    H: Hash_Table( 17 );
    P : Hash_Position;
    S : My_String;
                

    -- Hash function for String type
    function Hash( Key: String; Table_Size: Integer ) return Natural is
        Hash_Val : Natural := 0;
    begin
        for I in Key'range loop
            exit when Key( I ) = ' ';
            Hash_Val := ( Hash_Val * 32 + Character'Pos( Key( I ) ) )
                                mod Table_Size;
        end loop;

        return Hash_Val;
    end Hash;

    -- Main routine begins here
begin
    Make_Empty( H );   -- Not really needed in Ada95

    for I in S'range loop
        S( I ) := ' ';
    end loop;

    S( 1..4 ) := "Mark";
    Insert( S, H );
    S( 1..5 ) := "Marty";
    Insert( S, H );
    S( 1..6 ) := "Joseph";
    Insert( S, H );

    for I in S'range loop
        S( I ) := ' ';
    end loop;
    S( 1..4 ) := "Mark";
    Put( Retrieve( Find( S, H )  ) ); Put_Line( " Found." );


    for I in S'range loop
        S( I ) := ' ';
    end loop;
    S( 1..5 ) := "Marty";
    Put( Retrieve( Find( S, H ) ) ); Put_Line( " Found." );







Dec  9 12:10 1995  open_hash_table_test.adb Page 2



    for I in S'range loop
        S( I ) := ' ';
    end loop;
    S( 1..6 ) := "Joseph";
    Put( Retrieve( Find( S, H ) ) ); Put_Line( " Found." );

    -- This should raise Item_Not_Found
    for I in S'range loop
        S( I ) := ' ';
    end loop;
    S( 1..5 ) := "Marks";
    Put( Retrieve( Find( S, H ) ) ); Put_Line( " Found." );

exception
    when Item_Not_Found =>
        Put( S( 1..5 ) );
        Put_Line( " Not found." );
    when others => Put_Line( "Unknown exception" );
end Open_Hash_Table_Test;











































Jan 11 16:12 1996  closed_hash_table.ads Page 1


-- Generic Package Specification for Closed_Hash_Table
--     Implements a quadratic probing hash table
-- Requires:
--     Instantiated with any private type and
--     a Hash function for that type and
--     a "=" function for that type
-- Types defined:
--     Hash_Position       private type
--     Hash_Table(Positive) limited private type
-- Exceptions defined:
--     Item_Not_Found      raised when searches or deletions fail
-- Operations defined
--     (* throws Item_Not_Found)
--     Find *              returns Tree_Ptr of item in search tree
--     Insert              add a new item into hash table
--     Make_Empty          make a hash tree empty
--     Retrieve *          returns item in Hash_Position passed as parameter

generic
    type Element_Type is private;
    with function Hash( Key: Element_Type; Table_Size: Positive ) return Natural;
    with function "="( Left, Right: Element_Type ) return Boolean;

package Closed_Hash_Table is
    type Hash_Position is private;
    type Hash_Table( H_Size: Positive ) is limited private;

    function  Find( Key: Element_Type; H: Hash_Table ) return Hash_Position;
    procedure Insert( Key: Element_Type; H: in out Hash_Table );
    procedure Make_Empty( H: in out Hash_Table );
    function  Retrieve( P: Hash_Position; H: Hash_Table ) return Element_Type;

    Item_Not_Found : exception;

private
    type Kind_Of_Entry is ( Legitimate, Empty, Deleted );

    type Hash_Entry is
      record
        Element : Element_Type;
        Info	: Kind_Of_Entry := Empty;
      end record;

    type Hash_Position is new Natural;
    type Hash_Array is array( Natural range <> ) of Hash_Entry;

    type Hash_Table( H_Size: Positive ) is
      record
        The_Slots : Hash_Array( 0..H_Size );
      end record;

end Closed_Hash_Table;











Dec  9 13:30 1995  closed_hash_table.adb Page 1


-- Implementation of Closed_Hash_Table

package body Closed_Hash_Table is

    function Resolve_Hash_Pos( Key: Element_Type; H: Hash_Table )
                                return Hash_Position;


    -- Return Hash_Position of Key in Hash_Table
    -- Raise an exception if appropriate
    function Find( Key: Element_Type; H: Hash_Table ) return Hash_Position is
        Current_Pos : Natural := Natural( Resolve_Hash_Pos( Key, H ) );
        A_Slot      : Hash_Entry renames H.The_Slots( Current_Pos );
    begin
        if A_Slot.Info = Legitimate and then A_Slot.Element = Key then
            return Hash_Position( Current_Pos );
        end if;

        raise Item_Not_Found;
    end Find;

    -- Insert Key into Hash_Table
    -- Do not insert duplicates
    procedure Insert( Key: Element_Type; H: in out Hash_Table ) is
        Pos : Natural := Natural( Resolve_Hash_Pos( Key, H ) );
    begin
        if H.The_Slots( Pos ).Info /= Legitimate then	-- Ok to insert here 
            H.The_Slots( Pos ) := ( Key, Legitimate );
        end if;
    end Insert;

    -- Make Hash_Table empty
    procedure Make_Empty( H: in out Hash_Table ) is
    begin
        for I in H.The_Slots'range loop
            H.The_Slots( I ).Info := Empty;
        end loop;
    end Make_Empty;

    -- Return Item in Hash_Position P
    -- Note that H is unused
    -- Raise an exception if appropriate
    function Retrieve( P: Hash_Position; H: Hash_Table ) return Element_Type is
    begin
        if H.The_Slots( Natural( P ) ).Info = Legitimate then
            return H.The_Slots( Natural( P ) ).Element;
        else
            raise Item_Not_Found;
        end if;
    end Retrieve;

    -- Internal routine that computes location of Key
    -- This is where quadratic probing is used
    function Resolve_Hash_Pos( Key: Element_Type; H: Hash_Table )
                                return Hash_Position is
        Current_Pos : Natural := Hash( Key, H.H_Size );







Dec  9 13:30 1995  closed_hash_table.adb Page 2


        I           : Natural := 0;
    begin

        loop
            exit when H.The_Slots( Current_Pos ).Info = Empty;
            exit when H.The_Slots( Current_Pos ).Element = Key;

        -- Quadratic resolution: Find another cell
        -- This method avoids using the expensive mod operator 

            I := I + 1;
            Current_Pos := Current_Pos +  2 * I - 1;
            if Current_Pos >= H.H_Size then
                Current_Pos := Current_Pos - H.H_Size;
            end if;
        end loop;

        return Hash_Position( Current_Pos );
    end Resolve_Hash_Pos;

end Closed_Hash_Table;










































Dec  9 14:17 1995  closed_hash_table_test.adb Page 1


-- Simple test program for either Closed_Hash_Table
-- or Expanding_Closed_Hash_Table

with Expanding_Closed_Hash_Table;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Closed_Hash_Table_Test is

    function Hash( Key: Integer; Table_Size: Positive ) return Natural;
    package My_Hash is new Expanding_Closed_Hash_Table( Integer, Hash, "=" );
    use My_Hash;

    H: Hash_Table( 17 );
    P : Hash_Position;
    I : Positive;
    Val : Integer;

    -- Simple hash function for Integer
    function Hash( Key: Integer; Table_Size: Positive ) return Natural is
    begin
        return Key mod Table_Size;
    end Hash;

begin
    I := 1;
    while I < 600 loop
      begin
        Insert( I, H );
        P := Find( I, H );
        Put( I ); Put_Line( "Found." );
    
      exception
        when Item_Not_Found =>
            Put( I ); Put_Line( "Oops." );
      end;
        I := I + 5;
    end loop;

    I := 2;
    while I < 600 loop
      begin
        P := Find( I, H );
        Put( I ); Put_Line( "Found -- Oops." );
      exception
        when Item_Not_Found =>
            null;
      end;
        I := I + 5;
    end loop;
    
end Closed_Hash_Table_Test;











Jan 11 16:13 1996  expanding_closed_hash_table.ads Page 1


-- Generic Package Specification for Expanding_Closed_Hash_Table
--     Implements a quadratic probing hash table with rehashing
-- Requires:
--     Instantiated with any private type and
--     a Hash function for that type and
--     a "=" function for that type
-- Types defined:
--     Hash_Position       private type
--     Hash_Table(Positive) limited private type
-- Exceptions defined:
--     Item_Not_Found      raised when searches or deletions fail
-- Operations defined:
--     (* throws Item_Not_Found)
--     Initialization and Finalization are defined
--     Find *              returns Tree_Ptr of item in search tree
--     Insert              add a new item into hash table
--     Make_Empty          make a hash tree empty
--     Retrieve *          returns item in Hash_Position passed as parameter

with Ada.Finalization;

generic
    type Element_Type is private;
    with function Hash( Key: Element_Type; Table_Size: Positive ) return Natural;
    with function "="( Left, Right: Element_Type ) return Boolean;
package Expanding_Closed_Hash_Table is
    type Hash_Position is private;
    type Hash_Table( Initial_Size: Positive ) is
        new Ada.Finalization.Limited_Controlled with private;

    procedure Initialize( H: in out Hash_Table );
    procedure Finalize( H: in out Hash_Table );

    function  Find( Key: Element_Type; H: Hash_Table ) return Hash_Position;
    procedure Make_Empty( H: in out Hash_Table );
    procedure Insert( Key: Element_Type; H: in out Hash_Table );
    function  Retrieve( P: Hash_Position; H: Hash_Table ) return Element_Type;

    Item_Not_Found : exception;

private
    type Kind_Of_Entry is ( Legitimate, Empty, Deleted );

    type Hash_Entry is
      record
        Element : Element_Type;
        Info	: Kind_Of_Entry := Empty;
      end record;

    type Hash_Position is new Natural;
    type Hash_Array is array( Natural range <> ) of Hash_Entry;
    type Hash_Array_Ptr is access Hash_Array;

        -- Some internal routines
    function Clear_Table( Table_Size: Positive ) return Hash_Array_Ptr;
    function Resolve_Hash_Pos( Key: Element_Type; H: Hash_Table )







Jan 11 16:13 1996  expanding_closed_hash_table.ads Page 2


        return Hash_Position;
    procedure Rehash( H: in out Hash_Table );

    type Hash_Table( Initial_Size: Positive ) is
                 new Ada.Finalization.Limited_Controlled with
      record
        H_Size                : Positive       := Initial_Size;
        Num_Elements_In_Table : Integer        := 0;
        The_Slots             : Hash_Array_Ptr := Clear_Table( Initial_Size );
      end record;

end Expanding_Closed_Hash_Table;



















































Feb  7 10:18 1996  expanding_closed_hash_table.adb Page 1


-- Implementation of Expnading_Closed_Hash_Table
with Unchecked_Deallocation;

package body Expanding_Closed_Hash_Table is

    procedure Dispose is new Unchecked_Deallocation( Hash_Array, Hash_Array_Ptr );
    function Next_Prime( X : Integer ) return Integer;

    -- Initialize is null because array is allocated in record declaration
    procedure Initialize( H: in out Hash_Table ) is
    begin
        null;
    end Initialize;

    procedure Finalize( H: in out Hash_Table ) is
    begin
        Dispose( H.The_Slots );
    end Finalize;
    
    -- VISIBLE ROUTINES

    -- Return Hash_Position of Key in H
    -- Raise Item_Not_Found if appropriate
    function Find( Key: Element_Type; H: Hash_Table ) return Hash_Position is
        Current_Pos : Natural := Natural( Resolve_Hash_Pos( Key, H ) );
        A_Slot	  : Hash_Entry renames H.The_Slots( Current_Pos );
    begin
        if A_Slot.Info = Legitimate and then A_Slot.Element = Key then
            return Hash_Position( Current_Pos );
        end if;

        raise Item_Not_Found;
    end Find;

    -- Insert Key into Hash_Table H
    -- Duplicates are not inserted
    procedure Insert( Key: Element_Type; H: in out Hash_Table ) is
        Pos: Natural := Natural( Resolve_Hash_Pos( Key, H ) );

    begin
        if H.The_Slots( Pos ).Info /= Legitimate then	-- Ok to insert here 
            H.The_Slots( Pos ) := ( Key, Legitimate );
            H.Num_Elements_In_Table := H.Num_Elements_In_Table + 1;
            if H.Num_Elements_In_Table > H.H_Size / 2 then
                Rehash( H );
            end if;
        end if;
    end Insert;

    -- Make Hash_Table empty
    procedure Make_Empty( H: in out Hash_Table ) is
    begin
        for I in H.The_Slots'range loop
            H.The_Slots( I ).Info := Empty;
        end loop;
        H.Num_Elements_In_Table := 0;







Feb  7 10:18 1996  expanding_closed_hash_table.adb Page 2


    end Make_Empty;

    -- Return item in Hash_Position P
    -- Raise an exception if appropriate
    function Retrieve( P: Hash_Position; H: Hash_Table ) return Element_Type is
    begin
        if H.The_Slots( Natural( P ) ).Info = Legitimate then
            return H.The_Slots( Natural( P ) ).Element;
        else
            raise Item_Not_Found;
        end if;
    end Retrieve;

    -- INVISIBLE routines

    -- Return smallest prime >= X
    -- Assumes that X > 10
    function Next_Prime( X : Integer ) return Integer is
        P : Integer := X;   -- Possible prime
        I : Integer;
    begin
        if P mod 2 = 0 then
            P := P + 1;
        end if;

        I := 3;
        while I * I <= P loop
            if P mod I = 0 then
                return Next_Prime( P + 2 );
            else
                I := I + 2;
            end if;
        end loop;

        return P;
    end Next_Prime;

    -- Allocate a new Hash_Array
    function Clear_Table( Table_Size: Positive ) return Hash_Array_Ptr is
    begin
        return new Hash_Array( 0..Next_Prime( Table_Size ) - 1 );
    end Clear_Table;

    -- Return location of Key in Hash_Table H
    -- This is where quadratic probing is implemented
    function Resolve_Hash_Pos( Key: Element_Type; H: Hash_Table )
                                return Hash_Position is
        Current_Pos : Natural := Hash( Key, H.H_Size );
        I : Natural := 0;
    begin

        loop
            exit when H.The_Slots( Current_Pos ).Info = Empty;
            exit when H.The_Slots( Current_Pos ).Element = Key;

        -- Quadratic resolution: Find another cell







Feb  7 10:18 1996  expanding_closed_hash_table.adb Page 3


        -- This method avoids using the expensive mod operator  

            I := I + 1;
            Current_Pos := Current_Pos +  2 * I - 1;
            if Current_Pos >= H.H_Size then
                Current_Pos := Current_Pos - H.H_Size;
            end if;
        end loop;

        return Hash_Position( Current_Pos );
    end Resolve_Hash_Pos;

    -- Rehashing procedure
    -- Allocate a larger hash table, and free up old table
    procedure Rehash( H: in out Hash_Table ) is
        Old_Ptr : Hash_Array_Ptr := H.The_Slots;
    begin
        H.The_Slots := Clear_Table( 2 * H.The_Slots'Length );
        H.H_Size := H.The_Slots'Length;
        Make_Empty( H );

        for I in Old_Ptr'range loop
            if Old_Ptr( I ).Info = Legitimate then
                Insert( Old_Ptr( I ).Element, H );
            end if;
        end loop;

        Dispose( Old_Ptr );
    end Rehash;

end Expanding_Closed_Hash_Table;