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

{$A+,B+,D+,E-,F+,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T+,V-,X+,Y+}
{$M 65520,100000,655360}
{
Program compiled and tested With BP 7.0

WARNING since this Program is not using the fastest algorithm to
find it's Anagrams, long Delays can be expected For large
input-Strings.

Test have shown the following results:

  Length of Input       Number of anagrams found

        2                         2
        3                         6
        4                        24
        5                       120
        6                       720
        7                      5040

As can plainly be seen from this, the number of Anagrams For a
String of length N is a direct Function of the number of Anagrams
For a String of N-1. In fact the result is f(N) = N * f(N-1).

You might have recognised the infamous FACTORIAL Function!!!

Type
  MyType = LongInt;

Function NumberOfAnagrams(Var InputLen : MyType) : MyType;

  Var
    Temp : MyType;

  begin
    Temp := InputLen;
    if Temp >1 then
    begin
      Temp := Temp - 1;
      NumberOfAnagrams := InputLen * NumberOfAnagrams(Temp);
    end else
      NumberOfAnagrams := InputLen;
  end;

The above Function has been tested and found to work up to an input
length of 12. After that, Real numbers must be used. As a side note
the Maximum value computable was 1754 With MyType defined as
Extended and Numeric-Coprocessor enabled of course. Oh and BTW, the
parameter is passed as a Var so that the Stack doesn't blow up when
you use Extended Type!!!! As a result, you can't pass N-1 to the
Function. You have to STORE N-1 in a Var and pass that as parameter.
The net effect is that With Numeric Copro enabled, at 1754 it blows
up because of a MATH OVERFLOW, not a STACK OVERFLOW!!!

Based on these findings, I assume the possible anagrams can be
computed a lot faster simply by Realising that the possible Anagrams
For an input length of (N) can be found by finding all anagrams for
an input Length of (N-1) and inserting the additional letter in each
(N) positions in those Strings. Since this can not be done
recursively in memory, the obvious solution would be to to output
the anagrams strating With the first 4 or 5 caracters to a File,
because those can be found quickly enough, and then to read in each
String and apply the following caracters to each and Repeat this
process Until the final File is produced.

Here is an example:

      Anagrams For ABCD

      Output Anagrams For AB to File

        Giving      AB and BA

      read that in and apply the next letter in all possible positions

        Giving
                  abC
                  aCb
                  Cab
                &
                  baC
                  bCa
                  Cba

      Now Apply the D to this and get

                  abcD
                  abDc
                  aDbc
                  Dabc
                &

                  acbD
                  acDb
                  aDcb
                  Dacb

      Etc... YOU GET THE POINT!!!

BTW Expect LARGE Files if you become too enthousiastic With this!!!

  An Input of just 20 caracters long will generate a File of

        2,432,902,008,176,640,000 Anagrams
        That's
          2.4 Quintillion Anagrams

  Remember that each of those are 20 caracters long,
  add Carriage-return and line-feeds and you've got yourself a
  HUGE File ;-)

  In fact just a 10 Caracter input length will generate 3.6 Million
  Anagrams from a 10 Caracter input-String. Again add Cr-LFs and
  you've got yourself a 43.5 MEGAByte File!!!!!! but consider you
  are generating it from the previous File which comes to 3.5 MEG
  For an Input Length of 9 and you've got yourself 45 MEG of DISK in
  use For this job.

}
Uses
  Strings, Crt;

Const
  MaxAnagram = 1000;

Type
  AnagramArray = Array[0..MaxAnagram] of Word;
  AnagramStr   = Array[0..MaxAnagram] of Char;

Var
  Target       : AnagramStr;
  Size         : Word;
  Specimen     : AnagramArray;
  Index        : Word;
  AnagramCount : LongInt;

Procedure working;
Const
  CurrentCursor : Byte = 0;
  CursorArray   : Array[0..3] of Char = '|/-\';
begin
  CurrentCursor := Succ(CurrentCursor) mod 4;
  Write(CursorArray[CurrentCursor], #13);
end;

Procedure OutPutAnagram(Target : AnagramStr;
                        Var Specimen : AnagramArray; Size : Word);
Var
  Index : Word;
begin
  For Index := 0 to (Size - 1) do
    Write(Target[Specimen[Index]]);
  Writeln;
end;

Function IsAnagram(Var Specimen : AnagramArray; Size : Word) : Boolean;
Var
  Index1,
  Index2 : Word;
  Valid  : Boolean;
begin
  Valid  := True;
  Index1 := 0;
  While (Index1<Pred(Size)) and Valid do
  begin
    Index2 := Index1 + 1;
    While (Index2 < Size) and Valid do
    begin
      if Specimen[Index1] = Specimen[Index2] then
        Valid := False;
      inc(Index2);
    end;
    inc(Index1);
  end;
  IsAnagram := Valid;
end;

Procedure FindAnagrams(Target : AnagramStr;
                       Var Specimen : AnagramArray; Size : Word);
Var
  Index : Word;
  Carry : Boolean;
begin
  Repeat
    working;
    if IsAnagram(Specimen, Size) then
    begin
      OutputAnagram(Target, Specimen, Size);
      inc(AnagramCount);
    end;
    Index := 0;
    Repeat
      Specimen[Index] := (Specimen[Index] + 1) mod Size;
      Carry := not Boolean(Specimen[Index]);
      Inc(Index);
    Until (not Carry) or (Index >= Size);
  Until Carry and (Index >= Size);
end;

begin
  ClrScr;
  Write('Enter anagram Target: ');
  readln(Target);
  Writeln;
  AnagramCount := 0;
  Size := Strlen(Target);
  For Index := 0 to MaxAnagram do
    Specimen[Index] := 0;
  For Index := 0 to Size - 1 do
    Specimen[Index] := Size - Index - 1;
  FindAnagrams(Target, Specimen, Size);
  Writeln;
  Writeln(AnagramCount, ' Anagrams found With Source ', Target);
end.

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