Re: Generation of permutations

[Wes Groleau <wesgroleau@despammed.com>]

> Are there any good (Ada95) packages for generation of permutations
> (of elements in array) ?

I can't get through to a search engine, so I can't tell you
where to find the attached code now.  I got it from SIMTEL-20.
I have made some modifications to it.  I don't remember whether
any of my improvements included Ada-95 features.

------------------------------------------------------------------------------
-- Date/Author    15 Apr 1985 / Doug Bryan (Stanford University)
--
-- Copyright      (C) 1997 Doug Bryan, Wes Groleau, and
--                         the Free Software Foundation
--
-- Tedious but important Legal Stuff:
--
--    The original author claimed no copyright.  In order to protect
--    what seemed to be his intent, I am assigning copyright to the
--    Free Software Foundation with the condtions below.  I reserve the
--    right to revoke this assignment if and when requested by the
--    original author.
--
--    package Permutations is free software; you can redistribute it
--    and/or modify it under terms of the GNU General Public License as
--    published by the Free Software Foundation; either version 2, or
--    at your option) any later version. package Permutations is
--    distributed in the hope that it will be useful, but WITHOUT ANY
--    WARRANTY; without even the implied warranty of MERCHANTABILITY or
--    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
--    License for more details.  You should have received a copy of the
--    GNU General Public License distributed with GNARL; see file
--    COPYING.  If not, write to the Free Software Foundation, 59 Temple
--    Place - Suite 330, Boston, MA 02111-1307, USA.
--
--    As a special exception, if other files instantiate generics from
--    this package, and/or you link with other files to produce an
--    executable, this package does not by itself cause the resulting
--    executable to be covered by the GNU General Public License.  This
--    exception does not however invalidate any other reasons why the
--    executable file might be covered by the GNU Public License.
------------------------------------------------------------------------------

   -- Basic algorithm from:
   --    "Programming in Modula-2" by Niklaus Wirth
   --    Chapter 14: Recursion

Now just in case this is a homework assignment, I have
intentionally made the code uncompilable in a way that
should be quite easy for an Ada programmer to figure out
and undo.


with Exchange; package body Permutations is procedure Swap is new
Exchange
( Item_Type ); -- The procedure permutes the elements in the array
Of_Items.  -- Actually it permutes their indices and re-arranges the
items
-- within the list. It's irrelevant whether any or all of the items --
in
the list are equal (the same).  procedure
Iterate_Through_All_Permutations
(Of_Items : List_Type) is Buffer : List_Type (Of_Items'Range) :=
Of_Items;
procedure Permute (K : Index_Type) is -- Swap successive elements of
Buffer (Buffer'First .. K) -- and permute slices. This algorithm works
backwords -- through the array (in reverse Buffer'range).  begin if K =
Buffer'First then -- At the begining of the array. Done. Process result.
Process_One_Item (A_Permutation => Buffer); else --Decrement K and
permute
lower slice.  Permute (Index_Type'Pred (K)); -- Traverse lower slice. 
for
I in Buffer'First .. Index_Type'Pred (K) loop -- swap K-th and I-th
elements.  Swap (Buffer (I), Buffer (K)); -- Decrement K and permute
lower
slice.  Permute (Index_Type'Pred (K)); -- swap K-th and I-th elements
back
(restore).  Swap (Buffer (I), Buffer (K)); end loop; end if; end
Permute;
begin Permute (Buffer'Last); end Iterate_Through_All_Permutations; end
Permutations; -- -- Date/Author 15 Apr 1985 / Doug Bryan (Stanford
University) -- -- Copyright (C) 1997 Doug Bryan, Wes Groleau, and -- the
Free Software Foundation generic type Item_Type is private; type
Index_Type is (<>); type List_Type is array (Index_Type range <>) of
Item_Type; package Permutations is -- 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.  -- -- Tedious but important Legal Stuff:  --
--
The original author claimed no copyright. In order to protect -- what
seemed to be his intent, I am assigning copyright to the -- Free
Software
Foundation with the conditions and exceptions -- detailed in the package
body. I reserve the right to revoke this -- assignment if and when
requested by the original author.  generic with procedure
Process_One_Item
(A_Permutation : List_Type); procedure Iterate_Through_All_Permutations
(Of_Items : List_Type); -- For an actual parameter Of_Items of length n,
n! permutations -- will be produced.  end Permutations; --------
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;


-- 
Wes Groleau
http://freepages.rootsweb.com/~wgroleau