[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]