[ALexandr555]

Накатал сейчас программу для нечеткого сравнения строк по базе, используя алгоритм отсюда http://www.delphisources.ru/pages/fa...e_strings.html

сама функция поиска

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108

function TForm1.AI(word: string): string; var i: integer; k,p:integer; slovo: string; variants: TStringList; begin word:=AnsiLowerCase(copy(word,1,50));  for i:=0 to mozg.Count-1 do   begin    p:=0;    if copy(mozg.Strings[i],1,3)='<Q>' then     begin      for k:=1 to  length(mozg.Strings[i]) do if mozg.Strings[i][k]='<' then inc(p);      slovo:=mozg.Strings[i];      if p>1 then       begin       for p:=p downto 2 do        begin         delete(slovo,1,3);         if FindCompare.IndistinctMatching(4,word,copy(slovo,1,pos('<Q>',slovo)-1))>=80 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;         slovo:=copy(slovo,pos('<Q>',slovo)+1,length(slovo));        end;        delete(slovo,1,2);        if FindCompare.IndistinctMatching(4,word,slovo)>=80 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;       end     else      begin       slovo:=copy(slovo,4,length(slovo));       if FindCompare.IndistinctMatching(4,word,slovo)>=80 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;      end;     end;   end;  for i:=0 to mozg.Count-1 do   begin    p:=0;    if copy(mozg.Strings[i],1,3)='<Q>' then     begin      for k:=1 to  length(mozg.Strings[i]) do if mozg.Strings[i][k]='<' then inc(p);      slovo:=mozg.Strings[i];      if p>1 then       begin       for p:=p downto 2 do        begin         delete(slovo,1,3);         if FindCompare.IndistinctMatching(4,word,copy(slovo,1,pos('<Q>',slovo)-1))>=40 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;         slovo:=copy(slovo,pos('<Q>',slovo)+1,length(slovo));        end;        delete(slovo,1,2);        if FindCompare.IndistinctMatching(4,word,slovo)>=40 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;       end     else      begin       slovo:=copy(slovo,4,length(slovo));       if FindCompare.IndistinctMatching(4,word,slovo)>=40 then          begin           variants:=TStringList.Create;           for k:=i+1 to mozg.Count-1 do            if copy(mozg.Strings[k],1,3)='<A>' then variants.Add(copy(mozg.Strings[k],4,length(mozg.Strings[k]))) else break;           result:=variants.strings[random(variants.Count)];           variants.free;           exit;          end;      end;     end;   end; result:=rand.Strings[random(rand.count)]; end;

ищет фразу и ответ на неё, в файле с базой такого вида

<Q>Есть кто живой?
<A>Кто-то есть...
<Q>Здарова<Q>Здоровеньки
<A>Прювед
<A>Здоровее видали

сначало идет сравнение более точное от 80%, затем от 40% и если ничего не нашли рандомная фраза

но проблема больно долго ищет если ничего не найдено, хотелось бы услышать совет по оптимизации кода

и прикрепляю исходник, с базой если понадобится