[MasteR]

"Построение частотного словаря и проверка закона Ципфа"
Нужно написать программу, которая обрабатывает текстовые файлы, пополняя базу данных встречающихся слов, сохраняя частоту встречаемости слов.
По накопленному словарю построить гистограмму встречаемости слов разной длины и проверить закон Ципфа.
(желательно для хранения словаря использовать суффиксное дерево).
Люди знающие, подскажите с чего начать хотя бы

[Rosenkrantz]

Закон Ципфа говорит о том, что если проанализировать достаточно большой текст, то слово, которое чаще всего в нем встречается, будет встречаться примерно в два раза чаще, чем второе по частоте, в три раза - чем третье и т.д. Что в данном контексте означает слово "примерно" для абстрактной задачи сказать сложно, но, видимо, как-то можно определить допустимую погрешность, исходя, например, из общего объема текста. Или еще как-то.

Суффиксные деревья применяются для решения задачи поиска самой длинной повторяющейся подстроки в заданном тексте. Прочитать про них можно здесь: http://algolist.manual.ru/

Вот тут http://www.delphisources.ru/forum/showthread.php?t=2944 лежит программа, которая ищет в произвольном текстовом файле слова, встречающиеся в каждом предложении. Это не то, что вам нужно, но может быть полезным. А может и не быть

Вам нужно слова выбирать с учетом словоформ, как я понял?

[MasteR]

Ну да, союзы, предлоги - всё это. Пасиб, почитаем

[Rosenkrantz]

Спрашивая про словоформы, я имел в виду вот что: слова, допустим, "программист" и "программисты" нужно считать как одно слово или как разные? Потому, что если как разные, то здесь вообще не видно проблемы, разве что продумать грамотную организацию словаря для быстрого поиска. Если же это считается как одно слово, но в разных формах, то тогда уже хитрее алгоритм получается.

[MasteR]

Нет, всё-таки нужны слова. "программист" и "программисты" нужно считать как РАЗНЫЕ слова. Еще есть вопрос - подразумевает ли данная программы использование базы данных на Delphi (в условии есть фраза "пополняя базу данных встречающихся слов")?

[MasteR]

Проблема в том, как хранить этот частотный словарь?
Есть мнение по реализации программы:
"Заводишь большой массив структуры{слово,частота}. Открываешь файл. Считываешь слово. Автоматом заносишь его в массив. Частоту увеличиваешь на 1. Считываешь следущее слово. Пробегаешь по массиву от начального элемента до текущего. Смотришь, было ли оно там. Если было, частоту слова увеличиваешь на 1. Если нет помещаешь в массив новое слово. И так, пока не конец файла."
А где этот массив записей хранить тогда, в типизированном файле?

[voron_paa]

Попробуй написать класс...
А данные храни в xml и парси в класс...
Может так будет лучше..

[MasteR]

Для меня это звучит жестоко ))

[voron_paa]

Да не так уж это и страшно...
Тогда создай таблицу.. в БД..
А то типизированные долго обрабатывать будешь... если слов много..

[MasteR]

Код:

  public
    { Public declarations }
  end;
 
type
  PRec = ^TRec;
  TRec = record
    str: string;
    col: LongWord;
  end;
 
type
   zap = record
       slovo : string;
       chast : Longword;
   end;
 
var
  Form1: TForm1;
  mas_slov: array of zap;
  O: string;
 
implementation
 
{$R *.dfm}
 
function TrimEx( s: string ): string;
begin
   Result := s;
   Result := StringReplace( Result, ',', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '.', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '!', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '?', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '-', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, ';', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, ':', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '=', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '*', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '(', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, ')', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '/', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '_', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '"', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '+', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '\', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '<', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '>', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '[', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, ']', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '{', '', [rfReplaceAll, rfIgnoreCase] );
   Result := StringReplace( Result, '}', '', [rfReplaceAll, rfIgnoreCase] );
   // Убираем лишние символы..
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  StringCount: Word;
  sl: TStringList;
  l: TList;
  i, j: integer;
  s, tmp: string;
  r: PRec;
  f: boolean;
begin
   StringCount := 0;
   sl := TStringList.Create;
 
   // выделяем слова
   for i := 0 to Memo1.Lines.Count-1 do
   begin
      s := Memo1.Lines[i];
      while Length( s ) > 0 do
      begin
         if Pos( ' ', s ) > 0 then
         begin
            tmp := Copy( s, 1, Pos( ' ', s )-1 );
            Delete( s, 1, Pos( ' ', s ) );
            tmp := TrimEx( tmp );
         end
         else
         begin
            tmp := s;
            s := '';
            tmp := TrimEx( tmp );
         end;
         if Trim( tmp ) <> '' then
            sl.Add( tmp );
      end;
   end;
 
   StringCount := sl.Count;
 
   // Производим расчёт
   l := TList.Create;
   for i := 0 to sl.Count-1 do
   begin
      if l.Count = 0 then
      begin
         New( r );
         r^.str := sl[i];
         r^.col := 1;
         l.Add( r );
      end
      else
      begin
         f := false;
         for j := 0 to l.Count-1 do
         begin
            r := l[j];
            if r^.str = sl[i] then
            begin
               r^.col := r^.col + 1;
               l[j] := r;
               f := true;
               Break;
            end;
         end;
         if not f then
         begin
            New( r );
            r^.str := sl[i];
            r^.col := 1;
            l.Add( r );
         end;
      end;
   end;
 
   // Выводим результат
   for i := 0 to l.Count-1 do
   begin
      r := l[i];
 
      Memo2.Lines.Add( r^.str + ' - ' + IntToStr( r^.col ) + ' (' + Format( '%.2f%%', [r^.col/StringCount*100] ) + ')' );
//**********************************      
      mas_slov[i].slovo := r^.str;
      mas_slov[i].chast := r^.col;
//**********************************
   end;
 
   l.Free;
   sl.Free;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
 with OpenDialog1 do
  begin
   if not Execute then Exit;
   Memo1.Lines.LoadFromFile(FileName);
  end;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
 Var FST : TFileStream;
begin
  FST := TFileStream.Create('slov.txt',fmCreate);
  Memo2.Lines.SaveToStream(FST);
  FST.Free;
end;
 
end.

Не могу загнать данные (слово, частота) в массив записей mas_slov. Главное в Memo выводит r^.str и r^.col, а в массив нет!

[Rosenkrantz]

Код:

program WordFreq;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

var
  Dictionary: TStringList;

const
  WordDelimiters = ' !?.,;`-+*=/\<>()[]~{}'#39;

function  DictionarySortFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
  if      Integer(List.Objects[Index1]) > Integer(List.Objects[Index2]) then Result := 1
  else if Integer(List.Objects[Index1]) < Integer(List.Objects[Index2]) then Result := -1
  else
    Result := 0;
end;

procedure AddToDictionary(SWord: String);
var
  i: Integer;
begin
  SWord := AnsiLowerCase(SWord);
  if Dictionary.Find(SWord, i)
    then Dictionary.Objects[i] := Pointer(Integer(Dictionary.Objects[i]) + 1)
    else Dictionary.AddObject(SWord, Pointer(1));
end;

procedure ProcessString(S: String);
var
  SWord: String;
  i    : Integer;
begin
  if (S <> '') and (Pos(S[Length(S)], WordDelimiters) = 0) then
    S := S + WordDelimiters[1];

  i     := 1;
  SWord := '';
  while (i <= Length(S)) do
    if Pos(S[i], WordDelimiters) = 0 then begin
      SWord := SWord + S[i];
      Inc(i);
    end else begin
      if SWord <> '' then
        AddToDictionary(SWord);
      SWord := '';
      while Pos(S[i], WordDelimiters) <> 0 do
        Inc(i);
    end;
end;

var
  F : Text;
  S : String;
  i : Integer;
begin
  try
    if   (ParamCount < 1)
      or (Pos('?', ParamStr(1)) = 1)
      or (not FileExists(ParamStr(1))) then begin

      Writeln('Use: ' + ExtractFileName(ParamStr(0)) + ' <filename>');
      Exit;
    end;

    Dictionary := TStringList.Create;
    Dictionary.Sorted := True;

    AssignFile(F, ParamStr(1));
    Reset(F);
    while not Eof(F) do begin
      Readln(F, S);
      ProcessString(Trim(S));
    end;
    CloseFile(F);

    Dictionary.Sorted := False;
    Dictionary.CustomSort(DictionarySortFunc);

    Assign(F, ChangeFileExt(ParamStr(1), '.result'));
    Rewrite(F);
    for i := 0 to Dictionary.Count - 1 do
      Writeln(F, Integer(Dictionary.Objects[i]), ' - ', Dictionary[i]);
    CloseFile(F);
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

[MasteR]

Спасибо, Rosenkrantz.
НО частотный словарь хотелось бы хранить и наращивать, вкидывая на обработку новые тексты. Ладно, это мои проблемы. Больше нет времени, ничего координально править не буду.
Еще раз спасибо.

P.S. завтра пойду на защиту с комиссией, лишь бы не запарили не по делу

[MasteR]

Всё норм - сдал. Всем спасибо, тема закрыта.