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

    {
    DC>I have a little major problem... And offcourse I want YOU to help me!
    DC>I want to write something that gives of a 8-letter word all the possible
    DC>combinations. So that 'RDEPTRAO' gives 'PREDATOR'. I think it must be about
    DC>256 combinations. I don't need a program that gives 'PREDATOR' directly, but
    DC>just something that gives me all those possibilities.

    Here is something that may help you a little. It works fine on my
    PC with one small proviso. If you specify permutations of 8
    objects taken 8 at a time (what you want ...) then the program
    runs out of heap space. Try it will smaller numbers first - like
    permutations of 5 objects taken 3 at a time. This will show you
    how it works. You can then try to modify it so that it will not
    run out of memory generating the 40320 permutations that you are
    looking for.

      Program perms, written by Clive Moses. This program will
      generate all permutations of n objects, taken r at a time,
      memory allowing.

      Challenge: try to modify the program so that it will not
      guzzle massive amounts of memory generating its output.
    }

    program perms;

    { Program to generate permutations of n objects, taken m at a time.
      For test purposes: m <= n <= 8. The program, as implemented here,
      effectively uses a 'breadth-first' algorithm. If it could be changed
      to run in a 'depth-first' fashion, it would not be necessary to
      store all of the intermediate information used to create the
      permutations. A 'depth-first' algorithm might have to be recursive
      however.
    }

    uses  crt;

    type  str8   = string[8];

          torec   = ^rec;

          rec  = record
            perm,
            left  : str8;
            next  : torec;
          end;

    const objects : str8 = 'abcdefgh';

    var   m, n    : integer;
          first   : torec;

    procedure NewRec (var p : torec);
    begin
      NEW (p);
      with p^ do
      begin
        perm := '';
        left := '';
        next := NIL;
      end;
    end;

    procedure PrintPerms (var first : torec);
    var p     : torec;
        count : integer;
    begin
      p := first;
      count := 0;
      while p<>NIL do
      begin
        if p^.perm <> ''
        then
           begin
             write (p^.perm:8);
             inc (count);
           end;
        p := p^.next;
      end;
      writeln;
      writeln;
      writeln (count,' records printed.');
    end;

    procedure MakePerms (m, n : integer; var first : torec);
    var i,
        level : integer;
        p,
        p2,
        temp  : torec;
    begin
      writeln ('Permutations of ',n,' objects taken ',m,' at a time ...');
      writeln;
      if m <= n
      then
         begin
           level := 0;
           NewRec (first);
           first^.left := copy (objects, 1, n);
           while level < m do
           begin
             p2 := NIL;
             temp := NIL;
             p := first;
             NewRec (p2);
             while p <> NIL do
             begin
               for i := 1 to length(p^.left) do
               begin
                 if temp=NIL then temp := p2;
                 p2^.perm := p^.perm + p^.left[i];
                 p2^.left := p^.left;
                 delete (p2^.left, i, 1);
                 NewRec (p2^.next);
                 p2 := p2^.next;
               end;
               p := p^.next;
             end;
             inc (level);
             p := first;
             while p<>NIL do
             begin
               p2 := p^.next;
               dispose (p);
               p := p2;
             end;
             first := temp;
           end
         end;
    end;

    begin { Main Program }
      clrscr;
      first := NIL;
      writeln ('Memory available = ',memavail);
      writeln;
      repeat
        write ('Total number of objects: ');
        readln (n);
      until n in [1..8];
      repeat
        write ('Size of permutation:   ');
        readln (m);
      until m in [1..n];
      MakePerms (m, n, first);
      PrintPerms (first);
      writeln;
      writeln ('Memory available = ',memavail);
    end.

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