Песни о Паскале

5. Если слово найдено, нарастить его счетчик, а иначе вставить в список запись со счетчиком, равным единице.

6. Прейти к пункту 2.

В перечисленных действиях нет ничего нового. В самом деле, обработка строк – дело привычное, так же, как поиск в сортированном списке и вставка в него данных. Таким образом, нам остается лишь собрать все это воедино, что и сделано в программе «P_55_1».

Процедуры этой программы сходны с аналогичными из полицейской базы данных, их отличает лишь порядок сортировки. Если там сортировка выполнялась по номерам автомобилей, то здесь – по словам.

{ P_55_1 – Частотный анализатор текста }

type

      PRec = ^TRec; { Тип указатель на запись }

      TRec = record { Тип записи для подсчета слов }

      mWord : string[31]; { Слово из текста }

      mCount : Longint;       { Счетчик слов }

      mNext : PRec;       { Указатель на следующий элемент }

      end;

var List : PRec; { Указатель на начало списка (голова) }

      { Поиск в сортированном списке }

function Find(const aWord: string): PRec;

var p: PRec;

begin

p:= List; { Поиск начинаем с головы }

{ Двигаемся по списку, пока следующий элемент существует

и слово в нём меньше искомого }

while Assigned(p) and Assigned(p^.mNext) and (p^.mNext^.mWord <= aWord)

      do p:=p^.mNext;

{ Если конец списка не достигнут и слово совпадает… }

if Assigned(p) and (p^.mWord = aWord)

      then Find:= p { … то успешно! }

      else Find:= nil; { … а иначе не нашли }

end;

      { Размещение нового элемента в сортированном списке слов }

procedure AddToSortList(const aWord : string);

var p, q : PRec;

begin

New(p); { Создаем динамическую переменную-запись }

{ Размещаем данные в полях записи }

p^.mCount:= 1; p^.mWord:= aWord; p^.mNext:=nil;

{ Если список пуст… }

if not Assigned(List)

then List:= p { …голова указывает на первую запись }

else begin

      q:= List; { Поиск места вставки начинаем с головы }

      { Двигаемся по списку, пока следующий элемент существует

      и его номер меньше вставляемого }

      while Assigned(q^.mNext) and (q^.mNext^.mWord < aWord)

      do q:=q^.mNext;

      if q^.mWord > aWord then begin

      { вставка на первое место }

      p^.mNext:=List;       { первый становится вторым }

      List:=p;       { а текущий- первым }

      end else begin

      { вставка в середине или в конце списка }

      p^.mNext:=q^.mNext; { связываем текущий со следующим }

      q^.mNext:=p;       { связываем предыдущий с текущим }

      end

      end

end;

      { Добавление слова либо увеличение его счетчика }

procedure AddWord(const aWord : string);

var P : PRec;

begin

P:= Find(aWord);

if Assigned(p)

      then Inc(P^.mCount)

      else AddToSortList(aWord);

end;

      { Выделение и добавление слов из прочитанной строки }

procedure AddLine(S: string);

const CLetter = ['A'..'Z','_'];

      CDigits = ['0'..'9'];

var W : string; i : integer;

begin

{ переводим все буквы строки в верхний регистр }

for i:=1 to Length(S) do S[i]:= UpCase(S[i]);

while Length(S)>0 do begin

{ удаляем все небуквы в начале строки }