[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]

Код:

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 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

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]

Код:

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

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]

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