Основные операции с односвязным списком - Turbo Pascal - Ответ 3998549

program Project1;
 
type
  //Тип основных данных.
  TData = Integer;
  //Указатель на элемент списка.
  TPElem = ^TElem;
  //Элемент списка.
  TElem = record
    Data : TData; //Основные данные.
    PNext : TPElem; //Указатель на следующий элемент.
  end;
  //Список.
  TDList = record
    Cnt : Integer; //Количество элементов в списке.
    PFirst, PLast : TPElem; //Указатели на первый и на последний элементы списка.
  end;
 
//Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
//только в отношении пустого списка. Иначе, произойдёт утечка памяти.
procedure Init(var aList : TDList);
begin
  aList.Cnt := 0;
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец списка.
procedure Add(var aList : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
  Inc(aList.Cnt);
end;
 
//Освобождение памяти, занятой под список.
procedure Free(var aList : TDList);
var
  PElem, PDel : TPElem;
begin
  PElem := aList.PFirst;
  while PElem <> nil do begin
    PDel := PElem;
    PElem := PElem^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
//Распечатка всего списка.
procedure Print(var aList : TDList);
var
  PElem : TPElem;
  i : Integer;
begin
  PElem := aList.PFirst;
  i := 0;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Write(', ');
    Write(PElem^.Data);
    PElem := PElem^.PNext;
  end;
  Writeln;
end;
 
//Перестройка списка в обратном порядке.
procedure Reverse(var aList : TDList);
var
  PElem, PNext : TPElem;
begin
  aList.PLast := aList.PFirst;
  PNext := aList.PFirst;
  aList.PFirst := nil;
  while PNext <> nil do begin
    PElem := PNext;
    PNext := PNext^.PNext;
    PElem^.PNext := aList.PFirst;
    aList.PFirst := PElem;
  end;
end;
 
//Удаление элемента из однонаправленного списка по указателю на предыдущий элемент.
//Если указатель на предыдущий элемент равен NIL, то удаляется первый элемент списка.
procedure Del(var aList : TDList; var aPPrev : TPElem);
var
  PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  if aPPrev = nil then begin
    PDel := aList.PFirst;
    aList.PFirst := PDel^.PNext;
  end else begin
    PDel := aPPrev^.PNext;
    if PDel <> nil then aPPrev^.PNext := PDel^.PNext;
  end;
  if aList.PLast = PDel then aList.PLast := aPPrev;
  if PDel <> nil then begin
    Dispose(PDel);
    Dec(aList.Cnt);
  end;
end;
 
//Удаление из списка элементов с заданным значением.
function DelByVal(var aList : TDList; const aData : TData) : Integer;
var
  PElem, PPrev : TPElem;
  Cnt : Integer;
begin
  Cnt := 0;
  PPrev := nil; //Указатель на предыдущий элемент.
  PElem := aList.PFirst; //Указатель на текущий элемент.
  while PElem <> nil do begin
    if PElem^.Data = aData then begin
      //Переход к следующему элементу надо выполнить перед вызовом Del(), потому
      //что процедура Del() удалит текущий элемент.
      PElem := PElem^.PNext;
      Del(aList, PPrev);
      Inc(Cnt);
    end else begin
      PPrev := PElem;
      PElem := PElem^.PNext;
    end;
  end;
  DelByVal := Cnt; //Количество удалённых элементов.
end;
 
//Диалог добавления элементов в список.
procedure WorkAdd(var aList : TDList);
var
  S : String;
  Data : TData;
  Code : Integer;
begin
  Writeln('Добавление элементов в список.');
  Writeln('Ввод каждого значения завершайте нажатием Enter.');
  Writeln('Чтобы прекратить ввод оставьте пустую строку и нажмите Enter.');
  repeat
    Write('Элемент №', aList.Cnt + 1, ': ');
    Readln(S);
    if S = '' then begin
      Writeln('Отмена.');
      Code := 0;
    end else begin
      Val(S, Data, Code);
      if Code = 0 then begin
        Add(aList, Data);
        Writeln('Элемент добавлен.');
        Code := 1;
      end else
        Writeln('Неверный ввод. Повторите.');
    end;
  until Code = 0;
  Writeln('Ввод элементов списка завершён.');
end;
 
var
  L : TDList;
  Data : TData;
  Cmd, Code, Cnt : Integer;
  S : String;
begin
  //Начальная инициализация списка.
  Init(L);
 
  repeat
    //Меню
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в список.');
    Writeln('2: Распечатка списка.');
    Writeln('3: Удаление элементов по условию.');
    Writeln('4: Перестройка списка в обратном порядке.');
    Writeln('5: Удаление списка.');
    Writeln('6: Выход.');
    Write('Введите команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(L);
      2:
        if L.PFirst = nil then
          Writeln('Спиосок пуст.')
        else begin
          Writeln('Содержимое списка:');
          Print(L);
        end;
      3:
      begin
        Writeln('Элементы с заданным значением будут удалены из списка.');
        Writeln('Чтобы отменить операцию оставьте пустую строку и нажмите Enter.');
        repeat
          Write('Значение: ');
          Readln(S);
          if S = '' then begin
            Writeln('Операция отменена.');
            Code := 0;
          end else begin
            Val(S, Data, Code);
            if Code = 0 then begin
              Cnt := DelByVal(L, Data);
              Writeln('Список обработан. Количество удалённых элементов: ', Cnt);
              Code := 1;
            end else
              Writeln('Неверный ввод. Повторите.');
          end;
        until Code = 0;
      end;
      4:
      begin
        Reverse(L);
        Writeln('Список перестроен в обратном порядке.');
      end;
      5, 6:
      begin
        Free(L);
        Writeln('Список удалён из памяти (очищен).');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
  until Cmd = 6;
 
  Writeln('Работа программы завершена. Для выхода нажмите Enter.');
  Readln;
end.