Линейные динамические структуры - Delphi - Ответ 4602694

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData; {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, расположенный на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPStack : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := aPStack;
  aPStack := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPStack : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPStack = nil then Exit;
 
  PElem := aPStack;
  aPStack := PElem^.PNext;
  aData := PElem^.Data;
  Dispose(PElem);
  Pop := True;
end;
 
{Освобождение памяти, занятой стеком (очистка стека).}
procedure Free(var aPStack : TPElem);
var
  Data : TData;
begin
  while Pop(aPStack, Data) do;
end;
 
const
  {Множество разделителей слов.}
  D = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
var
  PSt1, PSt2 : TPElem;
  Data1, Data2 : TData;
  S : String;
  Cnt : Integer;
  B : Boolean;
begin
  {Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  Если после переключения русские буквы показываются неверно,
  следует открыть системное меню консольного окна - щелчком мыши в левом
  верхнем углу окна консоли и выбрать:
  Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".}
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  {Начальная инициализация стеков.}
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    Writeln('Задайте слова.');
    Writeln('Для завершения ввода оставьте пустую строку и нажмите Enter.');
    repeat
      Write('Слово: ');
      Readln(Data1);
      if Data1 <> '' then
        Push(PSt1, Data1)
      else
        Writeln('Ввод завершён.');
    until Data1 = '';
 
    {Решение задачи.}
    {Количество слов, для которых были найдены совпадения.}
    Cnt := 0;
    {Извлекаем слова из первого стека.}
    while Pop(PSt1, Data1) do begin
      {Поиск совпадений. Слова, которые совпадают с текущим - удаляем.
      Несовпадающие слова записываем во второй стек.}
      B := False;
      while Pop(PSt1, Data2) do
        if Data1 = Data2 then
          B := True
        else
          Push(PSt2, Data2);
      if B then Inc(Cnt);
      PSt1 := PSt2;
      PSt2 := nil;
    end;
 
    Writeln('Количество совпадающих слов: ', Cnt);
 
    {Освобождаем память, занятую для стеков. Сейчас стеки и так пусты,
    но грамотно построенный код должен содержать код освобождения памяти.
    Это повышает надёжность кода.}
    Free(PSt1);
    Free(PSt1);
    Writeln('Память, выделенная для стеков, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.