Contributor: MARK OUELLET
{$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.