慢字谜算法

Question

我一直在研究一种算法来重新排列单词的字母，但是找到正确的单词需要很长时间。

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;

如何改进这个算法？

Answer 1

如果您正在做的是检查给定字母的字谜是否在字典中，您可以执行以下操作：

1. （可以预先计算）为字典中的每个单词对字母进行排序，例如 store (aht=hat)。并根据名称对字典进行排序（TStringlist 可以使用名称值对来执行此操作）
2. 对字符串中的字母进行排序（例如 hello -> ehllo）
3. 在字典中搜索名称与排序后的字母字符串相同的项目。