Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/misc/search.ada

Text File | 1988-05-03 | 19.5 KB | 485 lines

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package Search_Utilities
-- Version      : 1.0 (MOOV115)
-- Author       : Geoffrey O. Mendal
--              : Stanford University
--              : Computer Systems Laboratory
--              : Stanford, CA  94305
--              : [phone] or 497-1175
-- DDN Address  : [e-mail]
-- Copyright    : (c) 1985 Geoffrey O. Mendal
-- Date created : Mon 11 Nov 85
-- Release date : Sun 25 Dec 85
-- Last update  : MENDAL Sun 25 Dec 85
-- Machine/System Compiled/Run on : DG MV10000, ROLM ADE
--                                  VAX 11/780, DEC ACS
--                                  RATIONAL R1000
-- Dependent Units : package SYSTEM
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  SEARCH
----------------:  SEARCH UTILITIES
--
-- Abstract     :  This generic package contains binary and
----------------:  sequential searching routines for arrays.
----------------:  A full paper describing this unit's
----------------:  capabilities is available by contacting the
----------------:  author at the above address.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION              AUTHOR     HISTORY
-- 12/29/85     1.0 (MOOV115)     Mendal     Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

-- Search_Utilities is a generic searching package. The SEARCH subprograms
-- will search a one dimensional array of any data type
-- indexed by discrete type components.

-- Note that the component type of the array is not restricted to simple
-- types. An array of records or allocators can be searched. If the
-- component type is a record or allocator, then the generic formal
-- subprogram parameter "<" below must be specified as a selector
-- function.

with SYSTEM;  -- predefined package SYSTEM

generic
  type Component_Type is limited private;  -- type of component to search for
  type Index_Type     is (<>);             -- type of array index

  -- the following generic formal type is required due to Ada's
  -- strong typing requirements. The SEARCH subprograms cannot handle
  -- anonymous array types. This type will match any unconstrained
  -- array type.

  type Array_Type is array(Index_Type range <>) of Component_Type;

  -- the following generic formal subprogram parameter defaults to
  -- an ascending order strategy. If records or access types are to
  -- be searched, a selector function must be specified. If the array
  -- is not ordered, the selector function need not be supplied.
  -- (See examples #2 and #3 below).

  with function "<"(Left,Right : in Component_Type) return BOOLEAN is <>;

  -- the following generic formal subprogram parameter defaults to
  -- the predefined equality operator. It can be used to specify a
  -- user-defined equality operation (see example #4 below).

  with function "="(Left, Right : in Component_Type) return BOOLEAN is <>;
package Search_Utilities is
  Search_Utilities_Version : constant STRING := "1.0 MOOV115";

  Component_Type_is_Unconstrained : exception;

  -- the following type should be used to specify how the data is
  -- ordered. The default is Not_Ordered. However, significant CPU time
  -- can be saved if the data is ordered and the default, Not_Ordered,
  -- is overridden.

  -- if the data are ordered, then if two or more components in the array
  -- can match the search component provided, then the component location
  -- returned by SEARCH should be thought of as an arbitrary selection
  -- from amongst those possible match-components.

  -- if the data are not ordered, then if two or more components in the
  -- array can match the search component provided, then the component
  -- location returned by SEARCH will be the one closest to
  -- Search_Array'FIRST.

  type Data_Order_Type is (Ordered,Not_Ordered);

  -- the following type declaration should be used to specify the
  -- instrumentation analysis data that can be returned by the
  -- SEARCH procedure below. -1 is only returned if an overflow in
  -- calculations has occurred. The SEARCH subprograms will not terminate
  -- if an overflow in instrumentation analysis data calculations has
  -- occurred.

  type Performance_Instrumentation_Type is range -1 .. SYSTEM.MAX_INT;

  -- the following procedure will search a one dimensional array of
  -- components. It can search an ordered or unordered array. If
  -- an ordered array is specified, it defaults to an ascending
  -- order (which can be overridden by the user). The array components
  -- must only support equality, inequality, and assignment (private
  -- types). The array indices can be of any discrete type. The number
  -- of comparisons can also be returned.

  procedure SEARCH(
    Component                        : in     Component_Type;
    Search_Array                     : in     Array_Type;
    Location_Found                   :    out Index_Type;
    Component_Found                  :    out BOOLEAN;
    Number_of_Comparisons            :    out Performance_Instrumentation_Type;
    Order_Strategy                   : in     Data_Order_Type := Not_Ordered;
    No_Match_Index                   : in     Index_Type      := Index_Type'LAST);

  -- the following overloading of procedure SEARCH should be used when
  -- no instrumentation analysis data are required.

  procedure SEARCH(
    Component                        : in     Component_Type;
    Search_Array                     : in     Array_Type;
    Location_Found                   :    out Index_Type;
    Component_Found                  :    out BOOLEAN;
    Order_Strategy                   : in     Data_Order_Type := Not_Ordered;
    No_Match_Index                   : in     Index_Type      := Index_Type'LAST);

  -- the following overloading of function SEARCH should be used when
  -- the user only wants to know if the component exists or not.

  function SEARCH(
    Component                        : in Component_Type;
    Search_Array                     : in Array_Type;
    Order_Strategy                   : in Data_Order_Type := Not_Ordered)
    return BOOLEAN;

  -- the following overloading of function SEARCH should be used when
  -- the component is definitely known to exist and only the location
  -- is required. (Note that No_Match_Index may be used to return a
  -- no match index value... but this won't work in all cases.)

  function SEARCH(
    Component                        : in Component_Type;
    Search_Array                     : in Array_Type;
    Order_Strategy                   : in Data_Order_Type := Not_Ordered;
    No_Match_Index                   : in Index_Type      := Index_Type'LAST)
    return Index_Type;
end Search_Utilities;

-- Example uses/instantiations:
--   EXAMPLE #1: Search an ascending ordered array of enumeration literals
--   with Search_Utilities,TEXT_IO;
--   . . .
--   type My_Component_Type is (Red,Blue,Green,Orange);
--   type My_Index_Type is (Sun,Mon,Tue,Wed,Thu,Fri,Sat);
--   type My_Array_Type is array(My_Index_Type range <>) of My_Component_Type;
--   . . .
--   My_Component : My_Component_Type;
--   My_Array     : My_Array_Type(Mon .. Fri);
--   Location     : My_Index_Type;
--   Found        : BOOLEAN;
--   . . .
--   package My_Search is new Search_Utilities(
--     Component_Type => My_Component_Type,
--     Index_Type     => My_Index_Type,
--     Array_Type     => My_Array_Type);
--   . . .
--   My_Search.SEARCH(
--     Component             => My_Component,
--     Search_Array          => My_Array,
--     Location_Found        => Location,
--     Component_Found       => Found,
--     Order_Strategy        => My_Search.Ordered);
--   if Found then
--     TEXT_IO.PUT_LINE("Component found");
--   else
--     TEXT_IO.PUT_LINE("Component not found");
--   end if;
--   . . .
--   end;  -- end of driver routine
--   -------------------------------------------------------------------
--   EXAMPLE #2: Search an unordered array of records
--   with Search_Utilities,TEXT_IO;
--   . . .
--   type My_Component_Type is
--     record
--       Field1 : INTEGER;
--       Field2 : FLOAT;
--     end record;
--   subtype My_Index_Type is INTEGER range -100 .. 100;
--   type My_Array_Type is array(My_Index_Type range <>) of My_Component_Type;
--   . . .
--   My_Component : My_Component_Type;
--   My_Array     : My_Array_Type(-100 .. 100);
--   . . .
--   package My_Search is new Search_Utilities(
--     Component_Type => My_Component_Type,
--     Index_Type  => My_Index_Type,
--     Array_Type   => My_Array_Type);
--   . . .
--   if My_Search.SEARCH(
--        Component        => My_Component,
--        Search_Array     => My_Array) then
--     TEXT_IO.PUT_LINE("Component found");
--   else
--     TEXT_IO.PUT_LINE("Component not found");
--   end if;
--   . . .
--   end;  -- end of driver routine
--   -------------------------------------------------------------------
--   Example #3: search an array of ordered access types
--   with Search_Utilities, TEXT_IO;
--   . . .
--   type Taxpayer_Type;  -- an incomplete type declaration
--   type Taxpayer_Access_Type is access Taxpayer_Type;
--   type Taxpayer_Type is
--     record
--       Name              : STRING(1 .. 40);
--       Age               : NATURAL;
--       ID_Number         : POSITIVE;  -- social security number
--     end record;
--   type My_Index_Type is range 1 .. 1_000_000;
--   type My_Array_Type is array(My_Index_Type range <>) of Taxpayer_Access_Type;
--   . . .
--   function Descending_Taxpayer_Search(Left,Right : in Taxpayer_Access_Type) return BOOLEAN;
--   . . .
--   package My_Search is new Search_Utilities(Taxpayer_Access_Type,
--     My_Index_Type,My_Array_Type,Descending_Taxpayer_Search);
--   . . .
--   My_Array                 : My_Array_Type(1 .. 1_000_000);
--   Number_of_Comparisons    : My_Search.Performance_Instrumentation_Type;
--   A_Component              : Taxpayer_Access_Type;
--   Location                 : My_Index_Type;
--   Found                    : BOOLEAN;
--   . . .
--   function Descending_Taxpayer_Search(Left,Right : in Taxpayer_Access_Type)
--     return BOOLEAN is
--   begin
--     return (Left.Name > Right.Name) or
--            ((Left.Name = Right.Name) and (Left.ID_Number > Right.ID_Number));
--   end Descending_Taxpayer_Search;
--   . . .
--   My_Search.SEARCH(A_Component,My_Array,Location,Found,Num_Compares,
--     My_Search.Ordered);
--   if Found then
--     TEXT_IO.PUT_LINE("Component found. Took " &
--       Search_Utilities.Performance_Instrumentation_Type'IMAGE(Num_Compares) &
--       " comparisons.");
--   end if;
--   . . .
--   end;   -- end of the driver routine
--   ---------------------------------------------------------------------------
--   EXAMPLE #4: Search an array of floating point numbers
--   with Search_Utilities;
--   . . .
--   type My_Array_Type is array(POSITIVE range <>) of FLOAT;
--   . . .
--   My_Array : My_Array_Type(1..10);
--   Location : POSITIVE;
--   Found    : BOOLEAN;
--   . . .
--   function My_Equality(L, R : in FLOAT) return BOOLEAN is
--   begin
--     . . .  -- check for "close enough" on equality
--     return <some BOOLEAN expression>
--   end My_Equality;
--   . . .
--   package My_Search_Utilities is new Search_Utilities(FLOAT,POSITIVE,My_Array_Type,
--     My_Equality);
--   . . .
--   My_Search.SEARCH(3.14159,My_Array,Location,Found);
--   . . .
--   end;  -- end of the driver routine

package body Search_Utilities is
  procedure SEARCH(
    Component                        : in     Component_Type;
    Search_Array                     : in     Array_Type;
    Location_Found                   :    out Index_Type;
    Component_Found                  :    out BOOLEAN;
    Number_of_Comparisons            :    out Performance_Instrumentation_Type;
    Order_Strategy                   : in     Data_Order_Type := Not_Ordered;
    No_Match_Index                   : in     Index_Type     := Index_Type'LAST) is

    Local_Comparisons : Performance_Instrumentation_Type := 0;

    -- the procedure below is a utility routine

    procedure Update_Performance_Instrumentation(
      Instrumentation_Count : in out Performance_Instrumentation_Type) is
    begin
      -- bump the counter unless an overflow has occurred

      if Instrumentation_Count /= Performance_Instrumentation_Type'FIRST then
        if Instrumentation_Count /= Performance_Instrumentation_Type'LAST then
          Instrumentation_Count := Instrumentation_Count + 1;
        else
          Instrumentation_Count := Performance_Instrumentation_Type'FIRST;
        end if;
      end if;
    end Update_Performance_Instrumentation;

    -- the two local procedures beLow perform two types of searches
    -- on the array: a binary search (if data is ordered), and
    -- a sequential search (if data is not ordered).

    procedure Binary_Search is
      High : Index_Type range Search_Array'FIRST .. Search_Array'LAST
        := Search_Array'LAST;
      Low  : Index_Type range Search_Array'FIRST .. Search_Array'LAST
        := Search_Array'FIRST;
      Curr : Index_Type range Search_Array'FIRST .. Search_Array'LAST
        := Index_Type'VAL((Index_Type'POS(High) + Index_Type'POS(Low)) / 2);
    begin
      while (Search_Array(Curr) /= Component) and (High > Low) loop
        Update_Performance_Instrumentation(Local_Comparisons);

        if Search_Array(Curr) < Component then
          if Curr = Search_Array'LAST then
            exit;  -- can't go any further, component not found
          else
            Low := Index_Type'SUCC(Curr);
          end if;
        elsif Curr = Search_Array'FIRST then
          exit;  -- can't go any further, component not found
        else
          High := Index_Type'PRED(Curr);
        end if;

        Curr := Index_Type'VAL((Index_Type'POS(High) +
          Index_Type'POS(Low)) / 2);
      end loop;

      if Search_Array(Curr) = Component then
        Location_Found := Curr;
        Component_Found := TRUE;
      else
        Location_Found := No_Match_Index;
        Component_Found := FALSE;
      end if;
    end Binary_Search;

    -- Sequential_Search will search for the component starting at the
    -- beginning of the array. This search technique is used only if
    -- the user's data is not sorted.

    procedure Sequential_Search is
      Index : Index_Type range Search_Array'FIRST .. Search_Array'LAST
        := Search_Array'FIRST;
    begin
      while (Index /= Search_Array'LAST) and
            (Search_Array(Index) /= Component) loop
        Update_Performance_Instrumentation(Local_Comparisons);
        Index := Index_Type'SUCC(Index);
      end loop;

      if Search_Array(Index) = Component then
        Location_Found := Index;
        Component_Found := TRUE;
      else
        Location_Found := No_Match_Index;
        Component_Found := FALSE;
      end if;
    end Sequential_Search;

  -- body of SEARCH folLows below

  begin
    -- check for an unconstrained component type

    if not Component_Type'CONSTRAINED then
      raise Component_Type_is_Unconstrained;
    end if;

    -- check for null array... a special case.

    if Search_Array'LAST < Search_Array'FIRST then
      Location_Found := No_Match_Index;
      Component_Found := FALSE;
    else
      case Order_Strategy is
        when Not_Ordered =>
          Sequential_Search;  -- search an unordered array
        when Ordered =>
          Binary_Search;      -- search an ordered array
      end case;
    end if;

    Number_of_Comparisons := Local_Comparisons;
  end SEARCH;

  -- the following overloading of SEARCH is used when instrumentation
  -- analysis data are not required.

  procedure SEARCH(
    Component                  : in     Component_Type;
    Search_Array               : in     Array_Type;
    Location_Found             :    out Index_Type;
    Component_Found            :    out BOOLEAN;
    Order_Strategy             : in     Data_Order_Type := Not_Ordered;
    No_Match_Index             : in     Index_Type     := Index_Type'LAST) is

    Dummy_Comparisons : Performance_Instrumentation_Type;
  begin
    SEARCH(Component,Search_Array,Location_Found,Component_Found,
      Dummy_Comparisons,Order_Strategy,No_Match_Index);
  end SEARCH;

  -- the following overloading of SEARCH should be used when only a
  -- boolean result is desired.

  function SEARCH(
    Component                  : in Component_Type;
    Search_Array               : in Array_Type;
    Order_Strategy             : in Data_Order_Type := Not_Ordered)
    return BOOLEAN is

    Component_Found   : BOOLEAN;
    Dummy_Location    : Index_Type;
    Dummy_Comparisons : Performance_Instrumentation_Type;
  begin
    SEARCH(Component,Search_Array,Dummy_Location,Component_Found,
      Dummy_Comparisons,Order_Strategy);

    return Component_Found;
  end SEARCH;

  -- the following overloading of SEARCH should be used when only an
  -- index result is desired.

  function SEARCH(
    Component                  : in Component_Type;
    Search_Array               : in Array_Type;
    Order_Strategy             : in Data_Order_Type := Not_Ordered;
    No_Match_Index             : in Index_Type      := Index_Type'LAST)
    return Index_Type is

    Location_Found    : Index_Type;
    Dummy_Component   : BOOLEAN;
    Dummy_Comparisons : Performance_Instrumentation_Type;
  begin
    SEARCH(Component,Search_Array,Location_Found,Dummy_Component,
      Dummy_Comparisons,Order_Strategy,No_Match_Index);

    return Location_Found;
  end SEARCH;
end Search_Utilities;
-------