Задача на частотный анализ текстового файла Опции

[Winniepoohless]

Собственно, условие подобной задачи (олимпиадской) на форуме приводилось (решение - нет):
Привожу еще раз условие:
Дан текст, в котором встречаются слова, состоящие из букв русского и латинского алфавитов и цифр, знаки препинания, пробелы и переводы строк. Требуется найти количество вхождений каждого слова в этот текст Для каждого слова при выводе в скобках указать количество его вхождений в текст.
*************************************************************************
Понятно, что решение надо делать через двоичное дерево. Часть программы есть, но не допру, как дальше:
uses
crt;
type
{ссылка на узел дерева}
TFindTreePtr = ^TFindTreeNode;
TFindtreeNode = record
info: word;
count: integer;
left, right: TFindTreePtr;
end;
var
InFile: Text; {исходный файл}
FileName: string; {имя файла данных}
root: TFindTreePtr;
str: word; {текущий обрабатываемое слово}
ErrCode: integer; {код ошибки при открытии файла}
ask: char; {символ-отклик при выборе режима вывода}
procedure Search (c: string; var node: TFindTreePtr);
begin
if node=nil then begin
node:=New(TFindTreePtr);
node^.info:=c;
node^.count:=1;
node^.left:=nil; {новый лист}
node^.right:=nil;
end
else if c< node^.info then
Search (c,node^.left)
else if c>node^.info then
Search (c,node^.right)
else
node^.count := node^.count+1;
end;

[klem4]

type
  PTInfo = ^TInfo;

  TInfo = Record
     _word: String;
    _count: LongInt;
     _next: PTInfo;
  end;

  PTInfoList = ^TInfoList;

  TInfoList = object
    first, last: PTInfo;

    constructor Create(const file_name: String);
    procedure   Run;
    destructor  Free;

    procedure Push(const _word: String);
    procedure PushOrInc(const _word: String);

    procedure Print;
  end;


constructor TInfoList.Create(const file_name: String);
const
  limits = ['.', ',', ' ', '!', '?', ';', ':'];
var
  f: Text;
  i, back: Byte;
  s: String;

begin
  first := nil;
  last := nil;

  assign(f, file_name);

  {$I-}
  reset(f);
  {$I+}

  if IOResult <> 0 then begin
    writeln('can''t open file "' + file_name, '"');
    readln;
    halt(1);
  end;

  while not eof(f) do begin
    readln(f, s);

    i := 1;
    while (i <= length(s)) do begin
      while (i <= length(s)) and (s[i] in limits) do
        inc(i);

      if i <= length(s) then begin
        back := i;

        while (i <= length(s)) and not (s[i] in limits) do
          inc(i);

        PushOrInc(copy(s, back, i - back));
      end;

    end;
  end;
end;

destructor TInfoList.Free;
var
  T: PTInfo;
begin
  while first <> nil do begin
    T := first;
    first := first^._next;
    Dispose(T);
  end;
end;

procedure TInfoList.Push(const _word: String);
var
  T: PTInfo;
begin
  New(T);

  T^._word  := _word;
  T^._next  := nil;
  T^._count := 1;

  if first = nil then
    first := T
  else
    last^._next := T;

  last := T;
end;

procedure TInfoList.PushOrInc(const _word: String);
var
  T: PTInfo;
begin
  T := first;
  {$B-}
  while (T <> nil) and (T^._word <> _word) do
    T := T^._next;
  {$B+}
  if T <> nil then
    inc(T^._count)
  else
    Push(_word);
end;

procedure TInfoList.Print;
var
  T: PTInfo;
begin
  T := first;
  while first <> nil do begin
    writeln(first^._word, '(', first^._count, ')');
    first := first^._next;
  end;
  first := T;
end;

procedure TInfoList.Run;
begin
  Print;
end;

var
  info_list: PTInfoList;
begin
  New(info_list, Create('C:\test.txt'));

  info_list^.Run;

  Dispose(info_list, Free);
end.

Сообщение отредактировано: klem4 - 31.01.2008 18:22