Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Разное
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Закрытая тема
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 16.12.2007, 11:58
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию "Построение частотного словаря и проверка закона Ципфа"

"Построение частотного словаря и проверка закона Ципфа"
Нужно написать программу, которая обрабатывает текстовые файлы, пополняя базу данных встречающихся слов, сохраняя частоту встречаемости слов.
По накопленному словарю построить гистограмму встречаемости слов разной длины и проверить закон Ципфа.
(желательно для хранения словаря использовать суффиксное дерево).
Люди знающие, подскажите с чего начать хотя бы
  #2  
Старый 16.12.2007, 17:28
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

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

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

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

Вам нужно слова выбирать с учетом словоформ, как я понял?
  #3  
Старый 22.12.2007, 17:59
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

Ну да, союзы, предлоги - всё это. Пасиб, почитаем
  #4  
Старый 24.12.2007, 05:30
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

Спрашивая про словоформы, я имел в виду вот что: слова, допустим, "программист" и "программисты" нужно считать как одно слово или как разные? Потому, что если как разные, то здесь вообще не видно проблемы, разве что продумать грамотную организацию словаря для быстрого поиска. Если же это считается как одно слово, но в разных формах, то тогда уже хитрее алгоритм получается.
  #5  
Старый 09.02.2008, 11:49
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

Нет, всё-таки нужны слова. "программист" и "программисты" нужно считать как РАЗНЫЕ слова. Еще есть вопрос - подразумевает ли данная программы использование базы данных на Delphi (в условии есть фраза "пополняя базу данных встречающихся слов")?
  #6  
Старый 10.02.2008, 15:33
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

Проблема в том, как хранить этот частотный словарь?
Есть мнение по реализации программы:
"Заводишь большой массив структуры{слово,частота}. Открываешь файл. Считываешь слово. Автоматом заносишь его в массив. Частоту увеличиваешь на 1. Считываешь следущее слово. Пробегаешь по массиву от начального элемента до текущего. Смотришь, было ли оно там. Если было, частоту слова увеличиваешь на 1. Если нет помещаешь в массив новое слово. И так, пока не конец файла."
А где этот массив записей хранить тогда, в типизированном файле?
  #7  
Старый 10.02.2008, 18:59
voron_paa voron_paa вне форума
Прохожий
 
Регистрация: 26.01.2008
Сообщения: 49
Репутация: 10
По умолчанию

Попробуй написать класс...
А данные храни в xml и парси в класс...
Может так будет лучше..
  #8  
Старый 10.02.2008, 20:40
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

Для меня это звучит жестоко ))
  #9  
Старый 11.02.2008, 23:00
voron_paa voron_paa вне форума
Прохожий
 
Регистрация: 26.01.2008
Сообщения: 49
Репутация: 10
По умолчанию

Да не так уж это и страшно...
Тогда создай таблицу.. в БД..
А то типизированные долго обрабатывать будешь... если слов много..
  #10  
Старый 12.02.2008, 21:49
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

Код:
  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, а в массив нет!
  #11  
Старый 13.02.2008, 09:15
Rosenkrantz Rosenkrantz вне форума
Активный
 
Регистрация: 04.12.2007
Адрес: Москва
Сообщения: 234
Версия Delphi: Delphi 7
Репутация: 40
По умолчанию

Код:
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.
  #12  
Старый 14.02.2008, 11:32
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

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

P.S. завтра пойду на защиту с комиссией, лишь бы не запарили не по делу
  #13  
Старый 15.02.2008, 22:55
MasteR MasteR вне форума
Прохожий
 
Регистрация: 14.05.2006
Сообщения: 12
Репутация: 10
По умолчанию

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


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 14:20.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter