Mega Code Archive
Anagram Algorythm Challenge (Uses MS Word Dictionary)
<![CDATA[
Title: Anagram Algorythm Challenge (Uses MS-Word Dictionary)
Question: This function finds valid Anagrams of a given word. I am using MS-Word OLE interface to check if the generated word is valid. Other methods or dictionaries could be used as this is rather slow. (Suggestions anyone ?)
The Algorythm is as follows ...
[1] Compute all Permutations of the word (n!)
[2] Check for duplicates
[3] Check a dictionary for valid word
Example : Anagram('EDIT',Memo1.Lines);
'edit' 'diet' 'tied' 'tide' 24 Words Checked - 4 Anagrams Found
Be careful with long words as n! (Permutations) can generate a huge amount of words progressively to check for and can take almost forever to run. ie.
3 Letters - 6 Permutations
4 Letters - 24 Permutations
6 Letters - 720 Permutations
9 Letters - 362,880 Permutations
10 Letters - 3,628,800
13 Letters - 6,227,020,800 Permutations
14 Letters - 87,178,291,200 Permutations
This obviously begs for optimisation. I have written the function in a standard manner which is not the "Ferrarri" that is probably required. All you Optimisation Freaks out there can probably go to town on this code to make it a viable user function :-)
Answer:
// ======================================================================
// Return a list of Anagrams - Careful, long words generate HUGE lists
// List of anagrams is returned in supplied String List
// ======================================================================
procedure Anagrams(const InString : string; StringList : TStrings);
var MsWordApp : OleVariant;
WordsChecked,WordsFound : integer;
// Internal Recursive routine
procedure RecursePerm(const StrA,StrB : string;
Len : integer;
SL : TStrings);
var i : integer;
A,B : string;
begin
// Is built up word the length we require ?
if (length(StrA) = Len) then begin
inc(WordsChecked);
// Check if not a duplicate and search dictionary for valid
// word check.
if (SL.IndexOf(StrA) = -1) and
MsWordApp.CheckSpelling(StrA) then begin
// OK, valid word - add to string list
inc(WordsFound);
SL.Add(StrA);
Application.ProcessMessages;
end;
end;
for i := 1 to length(StrB) do begin
// Recursively build all possible permutations of word
A := StrB;
B := StrA + A[i];
delete(A,i,1);
RecursePerm(B,A,Len,SL);
end;
end;
begin
try
// Connect to MS-Word for dictionary check
MsWordApp := CreateOleObject('Word.Application');
MsWordApp.Documents.Add;
WordsChecked := 0;
WordsFound := 0;
StringList.Clear;
Application.ProcessMessages;
// Change string to lowercase in case MS-Word settings to
// IGNORE capitalised words.
RecursePerm('',LowerCase(InString),length(InString),StringList);
MessageDlg('Anagram Search Check Complete' + #13#10 +
IntToStr(WordsChecked) + ' words checked' + #13#10 +
IntToStr(WordsFound) + ' anagrams found',
mtInformation,[mbOk],0);
MsWordApp.Quit;
MsWordApp := VarNull;
except
MessageDlg('MS-Word not Available',mtError,[mbOk],0);
end;
end;
]]>