-------- 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 -- : (415) 497-1414 or 497-1175 -- DDN Address : Mendal@SU-SIERRA.ARPA -- 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 -- 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; -------