home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / misc / pmutate.ada < prev    next >
Encoding:
Text File  |  1988-05-03  |  11.0 KB  |  307 lines
  1. -------- SIMTEL20 Ada Software Repository Prologue ------------
  2. --                                                           -*
  3. -- Unit name    : Permutations_Class
  4. -- Version      : 1.0
  5. -- Author       : Doug Bryan
  6. --              : Computer Systems Lab
  7. --              : Stanford University
  8. --              : Stanford CA, 94305
  9. -- DDN Address  : bryan@su-sierra
  10. -- Copyright    : (c) -none-
  11. -- Date created :  15 April 1985
  12. -- Release date :  15 April 1985
  13. -- Last update  :  15 April 1985
  14. -- Machine/System Compiled/Run on : DG MV/10000 ADE 2.2
  15. --
  16. ---------------------------------------------------------------
  17. --                                                           -*
  18. -- Keywords     :
  19. ----------------: permutations, recursion, nested generics,
  20. ----------------: iterators
  21. --
  22. -- Abstract     :
  23. ----------------: This is a generic package which, given an array
  24. ----------------: of items, forms all possible permutations using
  25. ----------------: these items.  The package does so by providing
  26. ----------------: a generic permutation class, within which is an
  27. ----------------: iterator.  The iterator has a generic formal
  28. ----------------: subprogram to which it passes each permutation.
  29. ----------------:
  30. ----------------: The package may make a nice example of the following
  31. ----------------: Ada features: nested generics, recursion, generic
  32. ----------------: formal subprograms as a method of implementing an
  33. ----------------: iterator.
  34. --                                                           -*
  35. ------------------ Revision history ---------------------------
  36. --                                                           -*
  37. -- DATE         VERSION    AUTHOR                  HISTORY
  38. --                                                           -*
  39. --     none yet...
  40. ------------------ Distribution and Copyright -----------------
  41. --                                                           -*
  42. -- This prologue must be included in all copies of this software.
  43. --
  44. -- This software is released to the Ada community.
  45. -- This software is released to the Public Domain (note:
  46. --   software released to the Public Domain is not subject
  47. --   to copyright protection).
  48. -- Restrictions on use or distribution:  NONE
  49. --                                                           -*
  50. ------------------ Disclaimer ---------------------------------
  51. --                                                           -*
  52. -- This software and its documentation are provided "AS IS" and
  53. -- without any expressed or implied warranties whatsoever.
  54. -- No warranties as to performance, merchantability, or fitness
  55. -- for a particular purpose exist.
  56. --
  57. -- Because of the diversity of conditions and hardware under
  58. -- which this software may be used, no warranty of fitness for
  59. -- a particular purpose is offered.  The user is advised to
  60. -- test the software thoroughly before relying on it.  The user
  61. -- must assume the entire risk and liability of using this
  62. -- software.
  63. --
  64. -- In no event shall any person or organization of people be
  65. -- held responsible for any direct, indirect, consequential
  66. -- or inconsequential damages or lost profits.
  67. --                                                           -*
  68. -------------------END-PROLOGUE--------------------------------
  69.  
  70. generic
  71.     type Item_Type  is private;
  72.     type Index_Type is (<>);
  73.     type List_Type  is array (Index_Type range <>) of Item_Type;
  74. package Permutations_Class is
  75.  
  76.     generic
  77.     with procedure Process (A_Permutation : List_Type);
  78.     procedure Iterate_Through_Length_Factorial_Permutations
  79.          (Of_Items : List_Type);
  80.  
  81.     -- For an actual parameter for Of_Items of length n, n! (n factorial)
  82.     -- permutations will be produced.
  83.  
  84.     -- The procedure permutes the elements in the array ITEMS.
  85.     -- actually it permutes their indicies and re-arranges the items
  86.     -- within the list.  The procedure does not care of any or all
  87.     -- of the items in the list are equal (the same).
  88.  
  89. end Permutations_Class;
  90.  
  91. ---------------------------------------------------------------
  92.  
  93. package body Permutations_Class is
  94.  
  95.     -----------------------------
  96.     -- Basic algorithm from:
  97.     --       "Programming in Modula-2" by Niklaus Wirth
  98.     --       Chapter 14: Recursion
  99.     -----------------------------
  100.     -- The procedure permutes the elements in the array ITEMS.
  101.     -- actually it permutes their indicies and re-arranges the items
  102.     -- within the list.  The procedure does not care of any or all
  103.     -- of the items in the list are equal (the same).
  104.     -----------------------------
  105.  
  106.     procedure Iterate_Through_Length_Factorial_Permutations
  107.          (Of_Items : List_Type) is
  108.  
  109.     Buffer : List_Type (Of_Items'Range) := Of_Items;
  110.  
  111.     ---------------------
  112.     procedure Permute (K_Th : Index_Type) is
  113.     -- Swap successive elements of Buffer (Buffer'first .. K_th)
  114.     -- and permute slices. This algorithm works backwords
  115.     -- through the array (in reverse Buffer'range).
  116.         Temp : Item_Type;
  117.     begin
  118.         if K_Th = Buffer'First then
  119.         -- At the begining of the array. Done.  Process result.
  120.         Process (A_Permutation => Buffer);
  121.         else
  122.         --Decrement K and permute lower slice.
  123.         Permute (Index_Type'Pred (K_Th));
  124.  
  125.         -- Traverse lower slice.
  126.         for I_Th in Buffer'First .. Index_Type'Pred (K_Th) loop
  127.             -- swap K-th and I-th elements.
  128.             Temp := Buffer (I_Th);
  129.             Buffer (I_Th) := Buffer (K_Th);
  130.             Buffer (K_Th) := Temp;
  131.  
  132.             -- Decrement K and permute lower slice.
  133.             Permute (Index_Type'Pred (K_Th));
  134.  
  135.             -- swap K-th and I-th elements back (restore).
  136.             Temp := Buffer (I_Th);
  137.             Buffer (I_Th) := Buffer (K_Th);
  138.             Buffer (K_Th) := Temp;
  139.         end loop;
  140.         end if;
  141.     end Permute;
  142.     ---------------------
  143.     begin
  144.     -- iterate_through_length_factorial_permutations
  145.     Permute (Buffer'Last);
  146.     end Iterate_Through_Length_Factorial_Permutations;
  147.  
  148. end Permutations_Class;
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158. -------- SIMTEL20 Ada Software Repository Prologue ------------
  159. --                                                           -*
  160. -- Unit name    : Permute_Test
  161. -- Version      : 1.0
  162. -- Author       : Doug Bryan
  163. --              : Computer Systems Lab
  164. --              : Stanford University
  165. --              : Stanford, CA 94305
  166. -- DDN Address  : bryan@su-sierra
  167. -- Copyright    : (c) -none-
  168. -- Date created :  15 April 1985
  169. -- Release date :  15 April 1985
  170. -- Last update  :  15 April 1985
  171. -- Machine/System Compiled/Run on : DG MV/10000 ADE 2.2
  172. --                                                           -*
  173. ---------------------------------------------------------------
  174. --                                                           -*
  175. -- Keywords     :  Test example instantiation
  176. ----------------:
  177. --
  178. -- Abstract     :
  179. ----------------:  This main program is simply a test and example
  180. ----------------:  use of the Permutation_Class package.
  181. ----------------:
  182. --                                                           -*
  183. ------------------ Revision history ---------------------------
  184. --                                                           -*
  185. -- DATE         VERSION    AUTHOR                  HISTORY
  186. --                                                           -*
  187. ------------------ Distribution and Copyright -----------------
  188. --                                                           -*
  189. -- This prologue must be included in all copies of this software.
  190. --
  191. -- This software is copyright by the author.
  192. --
  193. -- This software is released to the Ada community.
  194. -- This software is released to the Public Domain (note:
  195. --   software released to the Public Domain is not subject
  196. --   to copyright protection).
  197. -- Restrictions on use or distribution:  NONE
  198. --                                                           -*
  199. ------------------ Disclaimer ---------------------------------
  200. --                                                           -*
  201. -- This software and its documentation are provided "AS IS" and
  202. -- without any expressed or implied warranties whatsoever.
  203. -- No warranties as to performance, merchantability, or fitness
  204. -- for a particular purpose exist.
  205. --
  206. -- Because of the diversity of conditions and hardware under
  207. -- which this software may be used, no warranty of fitness for
  208. -- a particular purpose is offered.  The user is advised to
  209. -- test the software thoroughly before relying on it.  The user
  210. -- must assume the entire risk and liability of using this
  211. -- software.
  212. --
  213. -- In no event shall any person or organization of people be
  214. -- held responsible for any direct, indirect, consequential
  215. -- or inconsequential damages or lost profits.
  216. --                                                           -*
  217. -------------------END-PROLOGUE--------------------------------
  218. with Text_Io,
  219.      Permutations_Class;
  220. use Text_Io;
  221.  
  222. procedure Permute_Test is
  223.  
  224.     type Integer_List is array (Positive range <>) of Integer;
  225.  
  226.     package I_Perms is new Permutations_Class
  227.            (Item_Type  => Integer,
  228.         Index_Type => Positive,
  229.         List_Type  => Integer_List);
  230.     package C_Perms is new Permutations_Class
  231.            (Item_Type  => Character,
  232.         Index_Type => Positive,
  233.         List_Type  => String);
  234.  
  235.     procedure Print_Integer_List (A_List : Integer_List);
  236.     procedure Print_String       (A_String : String);
  237.  
  238.     procedure View_Integer_Perms is
  239.         new I_Perms.Iterate_Through_Length_Factorial_Permutations
  240.            (Process => Print_Integer_List);
  241.     procedure View_Character_Perms is
  242.         new C_Perms.Iterate_Through_Length_Factorial_Permutations
  243.            (Process => Print_String);
  244.  
  245.     package N_Io is new Integer_Io (Natural);
  246.     use N_Io;
  247.  
  248.     C : String (1 .. 20);
  249.     I : Integer_List (1 .. 20);
  250.     N : Natural;
  251.  
  252.     procedure Print_Integer_List (A_List : Integer_List) is
  253.     begin
  254.     for I in A_List'Range loop
  255.         Put (Integer'Image (A_List (I)));  Put (' ');
  256.     end loop;
  257.     New_Line;
  258.     end Print_Integer_List;
  259.  
  260.     procedure Print_String (A_String : String) is
  261.     begin
  262.     Put_Line (A_String);
  263.     end Print_String;
  264.  
  265. begin
  266.     -- test permute
  267.     New_Page;  New_Line (2);
  268.     Put_Line ("This thing permutes sequences. ");
  269.     Put ("Enter n (0 .. 20) > ");
  270.     Get (N);
  271.     New_Line;
  272.     Put_Line ("Enter " & Natural'Image (N) & " integers.");
  273.     for T in 1 .. N loop
  274.     Put (" > ");
  275.     Get (I (T));
  276.     end loop;
  277.     New_Line;
  278.     Put_Line ("The permutations of the sequence");
  279.     Put ("      ");
  280.     Print_Integer_List (I (1 .. N));
  281.     Put_Line ("                    are:");
  282.     View_Integer_Perms (I (1 .. N));
  283.     Put_Line ("------------------------------------------------");
  284.  
  285.     Put ("Enter n (0 .. 20) > ");
  286.     Get (N);
  287.     New_Line;
  288.     Put_Line ("Enter " & Natural'Image (N) & " characters.");
  289.     for T in 1 .. N loop
  290.     Put (" > ");
  291.     Get (C (T));
  292.     New_Line;
  293.     end loop;
  294.     New_Line;
  295.     Put_Line ("The permutations of the sequence");
  296.     Put ("      ");
  297.     Print_String (C (1 .. N));
  298.     Put_Line ("                    are:");
  299.     View_Character_Perms (C (1 .. N));
  300.  
  301. exception
  302.     when others =>  Put_Line ("Fatal exception propagation.");
  303. end Permute_Test;
  304.  
  305. pragma Main;
  306.  
  307.