Egy szó anagrammáinak elkészítése a Word szótárának segítségével

A feladat megoldásához készítünk két függvényt. Az egyik egy rekurzív függvény lesz, mely önmagát hívja meg. Ezzel fogjuk az adott szó anagrammáit elkészíteni. Az elkészítés módja a következő: vesszük az adott szó lehetséges permutációit, azaz az összes betűinek lehetséges sorrendjét. Ez a szó betűinek faktoriálisával egyenlő. Ez a következőképpen alakul az egyes szóhosszúságoknál:

Láthatjuk, hogy minél hosszabb egy szó, annál több a betűinek a lehetséges sorrendje. Ezért természetesen a függvény futtatása is jóval több időt vesz igénybe. Épp ezért célszerű rövidebb szavakkal próbálkozni. Miután összeállítottunk egy új szót, megnézzük, hogy az értelmes-e. Ehhez hívjuk segítségül a Word helyesírás-ellenőrző programját. A másik függvénnyel megnyitjuk a háttérben a Word-öt, meghívjuk a rekurzív függvényt, majd kilépünk a Word-ből. Először is nézzük meg ez utóbbi felépítését.

procedure TForm1.Anagrams(const InString : string; StringList : TStrings);
begin
  try

Megnyitjuk a Word-öt, majd létrehozunk egy új dokumentumot. Mivel a Word-öt nem jelenítjük meg, mindez a háttérben fog zajlani. Előzőleg a uses részben megadtuk a ComObj unit-ot.

    MsWordApp := CreateOleObject('Word.Application');
    MsWordApp.Documents.Add;
    WordsChecked := 0;
    WordsFound := 0;
    StringList.Clear;
    Application.ProcessMessages;

Meghívjuk a rekurzív függvényt. Paraméterként azt a szót adjuk át, melynek az anagrammáit keressük, és melyet az InString paraméterben tárolunk. Az anagrammákat egy StringList változóban kapjuk vissza. Mivel a Word helyesírás-ellenőrzője figyelmen kívül hagyja a nagybetűket, ezért a szót a LowerCase segítségével kisbetűssé konvertáljuk, mielőtt átadjuk a RecursePerm függvénynek.

    RecursePerm('',LowerCase(InString),length(InString),StringList);

A függvény meghívása után lezárjuk a Word-öt, majd egy üzenetet íratunk ki, melyben közöljük a felhasználóval, hogy hány szó lett megvizsgálva és ebből hány anagrammát sikerült készíteni.

    MsWordApp.Quit;
    MsWordApp := VarNull;
    MessageDlg('Az anagrammák keresése befejeződött!' + #13#10 +
                IntToStr(WordsChecked) + ' szó lett ellenőrizve, ebből' + #13#10 +
                IntToStr(WordsFound) + ' anagrammát találtam.',
                mtInformation,[mbOk],0);
  except
    MessageDlg('Az MS-Word nem elérhető!',mtError,[mbOk],0);
  end;
end;

Most nézzük, hogyan is készül el az anagramma a rekurzív függvényben.

procedure RecursePerm(const StrA,StrB:string;Len:integer;SL:TStrings);
var i : integer;
      A,B : string;
begin

Megvizsgáljuk, hogy az újonnan létrehozott szó hossza megfelel-e az eredeti szó hosszának.

    if (length(StrA) = Len) then begin
      inc(WordsChecked);

Ezután azt vizsgáljuk, hogy a létrehozott szó létezik-e már a listánkban, illetve megtalálható-e a Word szótárában.

      if (SL.IndexOf(StrA) = -1) and
         MsWordApp.CheckSpelling(StrA) then begin

Amennyiben létező szót kaptunk, hozzáadjuk azt a sztringlistához.

         inc(WordsFound);
         SL.Add(StrA);
         Application.ProcessMessages;
      end;
    end;

A függvény mindaddig meghívja önmagát, míg az összes lehetséges permutációt elő nem állította.

    for i := 1 to length(StrB) do begin
      A := StrB;
      B := StrA + A[i];
      delete(A,i,1);
      RecursePerm(B,A,Len,SL);
    end;
end;

A függvényt a következőképpen hívhatjuk meg:

  Anagrams(Edit1.Text,Memo1.Lines);

Az Edit1-ben megadott szó anagrammáit a Memo1-ben kapjuk vissza.