-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : Permutations_Class -- Version : 1.0 -- Author : Doug Bryan -- : Computer Systems Lab -- : Stanford University -- : Stanford CA, 94305 -- DDN Address : bryan@su-sierra -- Copyright : (c) -none- -- Date created : 15 April 1985 -- Release date : 15 April 1985 -- Last update : 15 April 1985 -- Machine/System Compiled/Run on : DG MV/10000 ADE 2.2 -- --------------------------------------------------------------- -- -* -- Keywords : ----------------: permutations, recursion, nested generics, ----------------: iterators -- -- Abstract : ----------------: This is a generic package which, given an array ----------------: of items, forms all possible permutations using ----------------: these items. The package does so by providing ----------------: a generic permutation class, within which is an ----------------: iterator. The iterator has a generic formal ----------------: subprogram to which it passes each permutation. ----------------: ----------------: The package may make a nice example of the following ----------------: Ada features: nested generics, recursion, generic ----------------: formal subprograms as a method of implementing an ----------------: iterator. -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- -* -- none yet... ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- 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-------------------------------- generic type Item_Type is private; type Index_Type is (<>); type List_Type is array (Index_Type range <>) of Item_Type; package Permutations_Class is generic with procedure Process (A_Permutation : List_Type); procedure Iterate_Through_Length_Factorial_Permutations (Of_Items : List_Type); -- For an actual parameter for Of_Items of length n, n! (n factorial) -- permutations will be produced. -- The procedure permutes the elements in the array ITEMS. -- actually it permutes their indicies and re-arranges the items -- within the list. The procedure does not care of any or all -- of the items in the list are equal (the same). end Permutations_Class; --------------------------------------------------------------- package body Permutations_Class is ----------------------------- -- Basic algorithm from: -- "Programming in Modula-2" by Niklaus Wirth -- Chapter 14: Recursion ----------------------------- -- The procedure permutes the elements in the array ITEMS. -- actually it permutes their indicies and re-arranges the items -- within the list. The procedure does not care of any or all -- of the items in the list are equal (the same). ----------------------------- procedure Iterate_Through_Length_Factorial_Permutations (Of_Items : List_Type) is Buffer : List_Type (Of_Items'Range) := Of_Items; --------------------- procedure Permute (K_Th : Index_Type) is -- Swap successive elements of Buffer (Buffer'first .. K_th) -- and permute slices. This algorithm works backwords -- through the array (in reverse Buffer'range). Temp : Item_Type; begin if K_Th = Buffer'First then -- At the begining of the array. Done. Process result. Process (A_Permutation => Buffer); else --Decrement K and permute lower slice. Permute (Index_Type'Pred (K_Th)); -- Traverse lower slice. for I_Th in Buffer'First .. Index_Type'Pred (K_Th) loop -- swap K-th and I-th elements. Temp := Buffer (I_Th); Buffer (I_Th) := Buffer (K_Th); Buffer (K_Th) := Temp; -- Decrement K and permute lower slice. Permute (Index_Type'Pred (K_Th)); -- swap K-th and I-th elements back (restore). Temp := Buffer (I_Th); Buffer (I_Th) := Buffer (K_Th); Buffer (K_Th) := Temp; end loop; end if; end Permute; --------------------- begin -- iterate_through_length_factorial_permutations Permute (Buffer'Last); end Iterate_Through_Length_Factorial_Permutations; end Permutations_Class; -------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : Permute_Test -- Version : 1.0 -- Author : Doug Bryan -- : Computer Systems Lab -- : Stanford University -- : Stanford, CA 94305 -- DDN Address : bryan@su-sierra -- Copyright : (c) -none- -- Date created : 15 April 1985 -- Release date : 15 April 1985 -- Last update : 15 April 1985 -- Machine/System Compiled/Run on : DG MV/10000 ADE 2.2 -- -* --------------------------------------------------------------- -- -* -- Keywords : Test example instantiation ----------------: -- -- Abstract : ----------------: This main program is simply a test and example ----------------: use of the Permutation_Class package. ----------------: -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- -* ------------------ 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-------------------------------- with Text_Io, Permutations_Class; use Text_Io; procedure Permute_Test is type Integer_List is array (Positive range <>) of Integer; package I_Perms is new Permutations_Class (Item_Type => Integer, Index_Type => Positive, List_Type => Integer_List); package C_Perms is new Permutations_Class (Item_Type => Character, Index_Type => Positive, List_Type => String); procedure Print_Integer_List (A_List : Integer_List); procedure Print_String (A_String : String); procedure View_Integer_Perms is new I_Perms.Iterate_Through_Length_Factorial_Permutations (Process => Print_Integer_List); procedure View_Character_Perms is new C_Perms.Iterate_Through_Length_Factorial_Permutations (Process => Print_String); package N_Io is new Integer_Io (Natural); use N_Io; C : String (1 .. 20); I : Integer_List (1 .. 20); N : Natural; procedure Print_Integer_List (A_List : Integer_List) is begin for I in A_List'Range loop Put (Integer'Image (A_List (I))); Put (' '); end loop; New_Line; end Print_Integer_List; procedure Print_String (A_String : String) is begin Put_Line (A_String); end Print_String; begin -- test permute New_Page; New_Line (2); Put_Line ("This thing permutes sequences. "); Put ("Enter n (0 .. 20) > "); Get (N); New_Line; Put_Line ("Enter " & Natural'Image (N) & " integers."); for T in 1 .. N loop Put (" > "); Get (I (T)); end loop; New_Line; Put_Line ("The permutations of the sequence"); Put (" "); Print_Integer_List (I (1 .. N)); Put_Line (" are:"); View_Integer_Perms (I (1 .. N)); Put_Line ("------------------------------------------------"); Put ("Enter n (0 .. 20) > "); Get (N); New_Line; Put_Line ("Enter " & Natural'Image (N) & " characters."); for T in 1 .. N loop Put (" > "); Get (C (T)); New_Line; end loop; New_Line; Put_Line ("The permutations of the sequence"); Put (" "); Print_String (C (1 .. N)); Put_Line (" are:"); View_Character_Perms (C (1 .. N)); exception when others => Put_Line ("Fatal exception propagation."); end Permute_Test; pragma Main;