[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}
{
  Copyright 1993 Mark Ouellet. All rights reserved.

  May be freely distributed and incorporated in your own code, in part
  or in it's entirety as long as due credit is given to it's author

  All I ask is that you state my name if you use ALL or PART of it in
  your own code.
}

Program FastAnagrams;

Uses
  Crt;

Type
  StrPointer = ^String;
  NodePtr = ^Node;
  Node    = Record
    Anagram : StrPointer;
    Next    : NodePtr;
  end;

Var
  OldAnagrams : NodePtr;
  NewAnagrams : NodePtr;
  OldCursor : NodePtr;
  NewCursor : NodePtr;
  InputStr : String;

Procedure GetInput;
begin
  ClrScr;
  Write('Input your String: ');
  readln(InputStr);
end;

Procedure FindAnagrams;

Var
  OldIndex : Word;
  NewIndex : Word;

begin
  OldAnagrams := NIL;
  OldCursor   := NIL;
  NewAnagrams := NIL;
  NewCursor   := NIL;

  New(OldCursor);
  OldCursor^.Next := OldAnagrams;
  GetMem(OldCursor^.Anagram, 2);
  OldCursor^.Anagram^ := Copy(InputStr, 1, 1);
  OldAnagrams := OldCursor;

  For OldIndex := 2 to Ord(InputStr[0]) do
  begin
    OldCursor := OldAnagrams;
    While OldCursor <> NIL do
    begin
      For NewIndex := 1 to Ord(OldCursor^.Anagram^[0])+1 do
      begin
        New(NewCursor);
        NewCursor^.Next := NewAnagrams;
        getmem(NewCursor^.Anagram, sizeof(OldCursor^.Anagram^)+1);
        NewCursor^.Anagram^ := OldCursor^.Anagram^;
        Insert(Copy(InputStr, OldIndex, 1),
          NewCursor^.Anagram^, NewIndex);
        NewAnagrams := NewCursor;
      end;
      OldCursor := OldCursor^.Next;
      FreeMem(OldAnagrams^.Anagram, Ord(OldAnagrams^.Anagram^[0])+1);
      OldAnagrams^.Anagram := nil;
      Dispose(OldAnagrams);
      OldAnagrams := OldCursor;
    end;
    OldAnagrams := NewAnagrams;
    OldCursor   := OldAnagrams;
    NewAnagrams := NIL;
    NewCursor   := NIL;
  end;
end;

Procedure OutputAnagrams;
Var
  Count : Word;
begin
  Count := 0;
  OldCursor := OldAnagrams;
  While OldCursor <> NIL do
  begin
    OldCursor := OldCursor^.Next;
    Writeln(OldAnagrams^.Anagram^);
    FreeMem(OldAnagrams^.Anagram, sizeof(OldAnagrams^.Anagram^));
    dispose(OldAnagrams);
    OldAnagrams := OldCursor;
    Inc(Count);
  end;
  Writeln;
  Writeln(Count, ' Anagrams found.');
end;

begin
  GetInput;
  Writeln;
  Writeln(MaxAvail, ' Available memory.');
  Writeln;
  FindAnagrams;
  OutputAnagrams;
end.

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