[Back to NUMBERS SWAG index]  [Back to Main SWAG index]  [Original]

{
Here is another attempt. It will also work with any length string
and generates all permutations without running out of memory, by
searching in a depth-first fashion.
}

{$M 64000,0,655360}

program perms2;

uses  Crt;

type  str52 = string[52];

const objects : str52 = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';

var   m, n,
      fw, level,
      nperline   : integer;
      p1, p2     : str52;
      nperms     : longint;

procedure p (var p1, p2 : str52; var level : integer);
var p1n, p2n  : str52;
    i, nlevel : integer;
begin
  if level < m
  then
     begin
       nlevel := level + 1;
       for i := 1 to length(p2) do
       begin
         p1n := p1 + p2[i];
         p2n := p2;
         delete (p2n, i, 1);
         p (p1n, p2n, nlevel);
       end;
     end
  else
     begin
       write (p1:fw);
       inc (nperms);
     end;
end;

begin
  repeat
    clrscr;
    repeat
      write ('How many objects altogether?  ');
      readln (n);
    until (n>=0) and (n<53);
    if n>0
    then
       begin
         repeat
           write ('How many in each permutation? ');
           readln (m);
         until (m>0) and (m<=n);
         writeln;
         case m of
           1      : fw := 2;    { 40 per line }
           2..3   : fw := 4;    { 20 per line }
           4      : fw := 5;    { 16 per line }
           5..7   : fw := 8;    { 10 per line }
           8..9   : fw := 10;   { 8 per line }
           10..15 : fw := 16;   { 5 per line }
           16..19 : fw := 20;   { 4 per line }
           20..39 : fw := 40;   { 2 per line }
           40..52 : fw := 80;   { 1 per line }
         end;
         nperline := 80 div fw;
         level := 0;
         p1 := '';
         p2 := copy (objects, 1, n);
         nperms := 0;
         p (p1, p2, level);
         if (nperms mod nperline) <> 0 then writeln;
         writeln;
         writeln (nperms,' Permutations generated.');
         readln;
       end;
  until n=0;
end.
{
This one is a little more elegant, and should also be a little
easier to decipher than the last one! Hope this will be of some
use to you!
}

[Back to NUMBERS SWAG index]  [Back to Main SWAG index]  [Original]