Hi,
I have been working on an algorithm to rearranging the letters of a word, but it takes much time to find the correct word.
var
Form1: TForm1;
DictionaryArray : array[0..2000] of string;
const Numbrs : string = '123456789';
implementation
{$R *.dfm}
function GenerateSequence(CPoint : String; L : Integer): String;
var
Increaser : array[1..8] of Integer;
i : Integer;
AnagramSequence : String;
begin
FillChar(Increaser, SizeOf(Increaser), 0);
for i := 1 to Length(CPoint) do
Increaser[9 - i] := StrToInt(CPoint[L + 1 - i]);
//==========================================//
if Increaser[8] <= L then
Increaser[8] := Increaser[8] + 1;
if Increaser[8] > L then
begin
Increaser[8] := 1;
Increaser[7] := Increaser[7] + 1;
end;
if (Increaser[7] > L - 1) and (L > 3) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := Increaser[6] + 1;
end;
if (Increaser[6] > L - 2) and (L > 4) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := Increaser[5] + 1;
end;
if (Increaser[5] > L - 3) and (L > 5) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := Increaser[4] + 1;
end;
if (Increaser[4] > L - 4) and (L > 6) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := Increaser[3] + 1;
end;
if (Increaser[3] > L - 5) and (L > 7) then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := 1;
Increaser[2] := Increaser[2] + 1;
end;
//==========================================//
AnagramSequence := IntToStr(Increaser[1]) + IntToStr(Increaser[2]) + IntToStr(Increaser[3]) + IntToStr(Increaser[4]) + IntToStr(Increaser[5]) + IntToStr(Increaser[6]) + IntToStr(Increaser[7]) + IntToStr(Increaser[8]);
Result := AnsiReplaceStr(AnagramSequence, '0', '')
end;
procedure LoadDictionary(DictionaryPath : String);
var
F : TextFile;
i : Integer;
begin
i := 0;
AssignFile(F, DictionaryPath);
Reset(F);
while not Eof(F) do
begin
Readln(F, DictionaryArray[i]);
Inc(i);
end;
CloseFile(F);
end;
function CheckInDictionary(RandedWord : String): Boolean;
begin
if (AnsiIndexText(RandedWord, DictionaryArray) = -1) then
Result := False
else
Result := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDictionary('wordlist.txt');
Label1.Caption := 'Dictionary: Loaded.';
Label1.Font.Color := clGreen;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
FRand, MRand, RandedWord, AnagramSequence : String;
RandedIndex, i : Integer;
begin
FRand := Edit1.Text;
MRand := FRand;
RandedWord := MRand;
AnagramSequence := StringOfChar('1', Length(FRand));
while CheckInDictionary(RandedWord) = False do
begin
MRand := FRand;
RandedWord := '';
AnagramSequence := GenerateSequence(AnagramSequence, Length(FRand));
for i := Length(AnagramSequence) downto 1 do
begin
Application.ProcessMessages;
RandedIndex := StrToInt(AnagramSequence[i]);
RandedWord := RandedWord + MRand[RandedIndex];
Delete(MRand, RandedIndex, 1);
end;
end;
Edit2.Text := RandedWord;
end;
How can i improve this algorithm?