Создание структуры бд для рерайтера

Posted by Chas under Delphi

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

%

немного|чуточку|чуток|чуть-чуть|малость|слегка

поправить|отредактировать|изменить

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

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

$noun:subject , котор@ -- Эт@ $noun:derivative

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

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

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

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

//Анализ формулы -- это вы можете спокойно убрать, так же как и знак "%" из базы синонимов

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 = ' ' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

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

 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) = Symbol then

   begin

    Result := true; Exit;

   end;

  end else

  begin

   if Alphabet = 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);
   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 = 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 = ' ' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

  end;
  if (not InAlphabet(Sentence, false)) and (not InAlphabet(Sentence, true)) then

  begin

   SetLength(Result, Length(Result) + 1);

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

   SetLength(Result, Length(Result) + 1);

   Continue;

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

 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 = '|' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

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

 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;

  if (memText.Text = '.') and ((i = Length(memText.Text)) or (InAlphabet(memText.Text, true))) then

   NewSentence := true

  else NewSentence := false;

 end;

end;
//При нажатии на кнопку генерации синонимизированного текста.

procedure TFormMain.bt_GenerateClick(Sender: TObject);

begin

 memGen.Clear;
 TextAnalysis;

 SentencesGenerate;

end;