home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARADIS1 / PERM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-06  |  3KB  |  80 lines

  1. (4174)  Sun 2 Feb 92  2:10
  2. By: Mitch Davis
  3. To: Trevor Carlsen and Frank Masingill
  4. Re: Sets
  5. St:
  6. ---------------------------------------------------------------------------
  7. @MSGID: 3:634/384.6 21020ed4
  8.  > FM> ...That will ask a user to enter 4 alpha characters, then take the
  9.  > FM> four characters and display them back in all 24 combinations.
  10.  
  11.  >  FM> begin
  12.  >  FM>   write('Enter 4 characters and press enter: ');  readln(st);
  13.  >  FM>   for w := 1 to 4 do
  14.  >  FM>     for x := 1 to 4 do
  15.  >  FM>       for y := 1 to 4 do
  16.  >  FM>         for z := 1 to 4 do
  17.  >  FM>         begin
  18.  >  FM>           s := [w,x,y,z];      {create a set}
  19.  >  FM>           if byte(s) = 30 then  {all 4 bits 1..4 are set}
  20.  >  FM>             writeln(st[w],st[x],st[y],st[z]);
  21.  >  FM>         end;
  22.  >  FM>   readln
  23.  >  FM> end.
  24.  
  25. etc.  YUCK!  What happens if you want to expand or shrink it?
  26.  
  27. A FAR nicer way is (tested):
  28.  
  29. -- 8< -----------------------------------------------------
  30. program ShowPerms;
  31.  
  32. const digits = 4; {How many digits to permute: n digits = n! perms}
  33.  
  34. var PermArray:array [1..digits] of byte; {Permutation holder}
  35.     ThisDigit:integer;
  36.  
  37. procedure writePerm; var loop:byte;
  38.  
  39. begin for loop := 1 to digits do write (PermArray [loop]); writeln; end;
  40.  
  41. procedure PermuteAtLevel (Level:integer);
  42.  
  43. var loop:integer;
  44.  
  45. begin
  46.   inc (ThisDigit); PermArray [Level] := ThisDigit;
  47.   if ThisDigit = digits then writeperm; {If we've accounted for all digits}
  48.   for loop := 1 to digits do if PermArray [loop] = 0
  49.     then PermuteAtLevel (loop);
  50.   dec (ThisDigit); PermArray [Level] := 0;
  51. end;
  52.  
  53. begin
  54.   ThisDigit := -1; {Left of Left-hand-side}
  55.   Fillchar (PermArray,sizeof (PermArray),#0); {Make it zeroes}
  56.   PermuteAtLevel (0); {Start at the bottom}
  57. end.
  58.  
  59. This works for any level, although you might wait a while for the higher
  60. numbers (eg Digits = 16 = 16! perms > 2^50!).  It is very efficient compared to
  61. the algorithm you've been studying.  This problem is one which can be easily
  62. solved with graph theory.
  63. I used "Algorithms" p628 by Robert Sedgewick as my starting point.  If you
  64. don't yet have an algorithm cookbook, then I _thoroughly_ recommend this book
  65. (also available for C).  There are very few algorithms NOT in it.  ISBN
  66. 0-201-06673-4.
  67. BTW, the original question called for perms of characters.  Read in a 4
  68. character string, then replace the write in WritePerm with:
  69.  
  70.   write (MyString [PermArray [loop]]);
  71.  
  72. To spec!
  73.  
  74. Mitch.
  75.  
  76. --- FD 1.99c
  77.  * Origin: Point Mitch: Daddy, stop the car! I'm going to be .. (3:634/384.6)
  78.  
  79. @PATH: 634/384 640/821 209/209 13/13 396/1 170/400 512/0 1007 
  80.