Типа синонимайзер

[Neeter]

Вы что, какой INI... Структура такой базы синонимов крайне неудобна. Вот смотрите, у вас так:

[привет]
1=здравствуйте
2=добрый день

А если в тексте написано "здравствуйте"? Вам придется заново писать то же самое, только в группе [Здравствуйте]:

[здравствуйте]
1=привет
1=добрый день

Согласитесь, это не только увеличивает объем базы, но и замедляет работу самого синонимайзера, который проходится по всем группам ini-файла.

Гораздо лучше использовать файл базы со своей структурой. У меня структура такая:

%
немного|чуточку|чуток|чуть-чуть|малость|слегка
поправить|отредактировать|изменить

Если рерайтер (я создаю именно рерайтер, а не простой синонимайзер) найдет в тексте слово "чуток", то он его заменит на "немного", "чуточку", "чуть-чуть", "малость" или "слегка". И не надо для каждого слова писать отдельную строчку, а тем более группу.

Главная сложность - создать интерпретатор для такой структуры файлов. Ведь рерайтер - это не просто замена одиночных слов на их синонимы. Вот, например, я создал и обработку конструкций "который":

$noun:subject , котор@ -- Эт@ $noun:derivative
* $noun:object , котор@ $verb -- * $noun , $participle:derivative-verb

Не буду объяснять, что значат эти строчки, могу только сказать, что здесь происходит замена конструкции "который" на причастный оборот. Например, предложение: "Человек, который любит подумать", заменится на: "Человек, любящий подумать".

Но вы уж тут сами разбирайтесь с такими сложными обработками. Я приведу код только синонимизации (потому что код рерайтера я никому не отдам... ).

[Neeter]

После вырезки некоторых строчек кода, управляющих обработкой формул типа "который", получилось вот это:

//Анализ формулы -- это вы можете спокойно убрать, так же как и знак "%" из базы синонимов
function TFormMain.FormulaAnalyse(Formula: string): TVarStr;
var i: integer;
begin
 SetLength(Result, 0);
 SetLength(Result, 1);

 for i := 1 to Length(Formula) do
 begin
  if Formula[i] = ' ' then
  begin
   SetLength(Result, Length(Result) + 1);
   Continue;
  end;

  Result[Length(Result)-1] := Result[Length(Result)-1] + Formula[i];
 end;
end;

//Это просто проверка символа на причастность к алфавиту :) т.е. буква ли это
function TFormMain.InAlphabet(Symbol: char; upper: boolean): boolean;
var i: integer;
begin
 Result := false;
 for i := 0 to 32 do
  if upper then
  begin
   if AnsiUpperCase(Alphabet[i]) = Symbol then
   begin
    Result := true; Exit;
   end;
  end else
  begin
   if Alphabet[i] = Symbol then //На всякий случай: Alphabet - это массив из литер
   begin
    Result := true; Exit;
   end;
  end;
end;

//Сама процедура генерации синонимизированного текста
procedure TFormMain.SentencesGenerate;
var
 i, j, o, y, u: integer;
 AnalyseFile: TStrings;
 Formula: string;
 FormComp: TVarStr;     
 SentComp: TVarStr;     
 Synonims: TVarStr;
 s: string;
 c: char;
 n: integer;
 check_f: boolean;
label l;
begin
 AnalyseFile := TStringList.Create;
 try
  AnalyseFile.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Data\Syn_Words.txt');
  Formula := AnalyseFile[0];

  FormComp := FormulaAnalyse(Formula);

  for i := 0 to Length(Sentences) - 1 do
  begin
   SentComp := SentenceAnalyse(Sentences[i]);

   for j := 0 to Length(FormComp) - 1 do
   begin
    if FormComp[j] = '%' then
    begin
     for o := 0 to Length(SentComp) - 1 do
     begin
      s := '';

      for y := 1 to AnalyseFile.Count - 1 do
      begin
       Synonims := SynonimsAnalyse(AnalyseFile[y]);
       for u := 0 to Length(Synonims) - 1 do
       begin
        if Synonims[u] = SentComp[o] then
        begin
         l: n := Random(Length(Synonims));

         if Synonims[n] = SentComp[o] then goto l
         else s := Synonims[n];
         Break;
        end;
       end;
      end;

      if s <> '' then memGen.Text := memGen.Text + ' ' + s
      else begin
       if Length(SentComp[o]) = 1 then
       begin
        c := SentComp[o][1];
        if (not InAlphabet(c, False)) and (not InAlphabet(c, true)) then
         memGen.Text := memGen.Text + SentComp[o]
        else memGen.Text := memGen.Text + ' ' + SentComp[o];
       end
       else memGen.Text := memGen.Text + ' ' + SentComp[o];
      end;
     end;
    end;
   end;
  end;

  memGen.Text := Trim(memGen.Text);
 finally
  AnalyseFile.Free;
  SetLength(FormComp, 0);
  SetLength(SentComp, 0);
  SetLength(Synonims, 0);
 end;
end;

//Анализ предложения; идет разбивка на слова и пунктуационные знаки
function TFormMain.SentenceAnalyse(Sentence: string): TVarStr;
var i: integer;
begin
 SetLength(Result, 0);
 SetLength(Result, 1);

 for i := 1 to Length(Sentence) do
 begin
  if Sentence[i] = ' ' then
  begin
   SetLength(Result, Length(Result) + 1);
   Continue;
  end;

  if (not InAlphabet(Sentence[i], false)) and (not InAlphabet(Sentence[i], true)) then
  begin
   SetLength(Result, Length(Result) + 1);
   Result[Length(Result)-1] := Sentence[i];
   SetLength(Result, Length(Result) + 1);
   Continue;
  end;

  Result[Length(Result)-1] := Result[Length(Result)-1] + Sentence[i];
 end;
end;

//Анализ базы синонимов; идет разбивка на слова-синонимы
function TFormMain.SynonimsAnalyse(Synonims: string): TVarStr;
var i: integer;
begin
 SetLength(Result, 0);
 SetLength(Result, 1);
 for i := 1 to Length(Synonims) do
 begin
  if Synonims[i] = '|' then
  begin
   SetLength(Result, Length(Result) + 1);
   Continue;
  end;

  Result[Length(Result)-1] := Result[Length(Result)-1] + Synonims[i];
 end;
end;

//Анализ текста; идет разбивка на предложения
procedure TFormMain.TextAnalysis;
var
 i: integer;
 NewSentence: boolean;
begin
 memText.Text := Trim(memText.Text);

 NewSentence := true;
 SetLength(Sentences, 0);
 for i := 1 to Length(memText.Text) do
 begin
  if NewSentence then SetLength(Sentences, Length(Sentences) + 1);
  Sentences[Length(Sentences)-1] := Sentences[Length(Sentences)-1] + memText.Text[i];
  if (memText.Text[i] = '.') and ((i = Length(memText.Text)) or (InAlphabet(memText.Text[i+2], true))) then
   NewSentence := true
  else NewSentence := false;
 end;
end;

//При нажатии на кнопку генерации синонимизированного текста.
procedure TFormMain.bt_GenerateClick(Sender: TObject);
begin
 memGen.Clear;

 TextAnalysis;
 SentencesGenerate;
end;

Код меняйте под свои нужды. Но вопросов по его работе задавать не стоит. Отвечать не буду. Во всем можете разобраться сами.

[Neeter]

Прикреплю вам испытательный полигон для опытов.

P.S. Генерация происходит при нажатии второй "безкартиночной" кнопки на toolbar'е

[kardinal94]

Огромное всем спасибо. ПОшел экспериментировать

[psycho-coder]

Думаю моя помощь тут теперь не нужна))
2Neeter Спасибо за исходник, нужно будет поразбираться)

[kynavs]

2Neeter огромадное спасибо - сэкономил огромное к-во времени