В динамическом списке найти первый наименьший и последний наибольший элементы и удалить все элементы, расположенные между ними.

var i,n,imax,imin:integer;
a:array[1..100] of real;
max,min:real;
begin
Write('Введите количество элементов:');readln(n);
for i:=1 to n do begin
a[i]:=random(50);
write(a[i]:5:2,' ');
end;
writeln;
max:=a[1];
for i:=2 to n do 
if a[i]>=max then begin
max:=a[i];
imax:=i;
end;
min:=a[n];
for i:=n-1 downto 1 do 
if a[i]<=min then begin
min:=a[i];
imin:=i;
end;
if imin>imax then begin
for i:=1 to imax do
write(a[i]:5:2,' ');
for i:=imin to n do
write(a[i]:5:2,' ');
end
else
begin
for i:=1 to imin do
write(a[i]:5:2,' ');
for i:=imax to n do
write(a[i]:5:2,' ');
end;
if imin=imax then
writeln(a[imax]:5:2,' ');
end.;

uses crt;
type
  PList = ^TList;
  TList = record
    info: integer;
    next : PList;
  end;
 
var
  head,tail,minel,maxel : PList;
 
{процедура формирует список с двумя сторожами}
procedure MakeList(Var head,tail:PList);
Var
  p,q:PList;
  n,i:integer;
begin {MakeList}
  writeln('Введите количество элементов списка');
  readln(n);
  randomize;
  new(head);
  new(tail);
  head^.next:=tail;
  p:=head;
  for i:=1 to n do
  begin
    new(q);
    q^.info:=random(50);
    q^.next:=tail;
    p^.next:=q;
    p:=q;
  end;
end;{MakeList}
 
{процедура выводит список на экран}
 procedure PrintList(head,tail:PList);
 Var
   p:PList;
 begin {PrintList}
   p:=head^.next;
   while p<>tail do
   begin
     write(p^.info:6);
     p:=p^.next;
   end;
   writeln;
 end;{PrintList}
 
function find_min:PList;
var curr, minn:PList;
x:integer;
begin
 curr:=head;
 x:=curr^.info;
 
 repeat
  if curr^.info<x then
 begin
 x:=curr^.info; minn:=curr;
 end;
 until curr^.next = nil;
 
 find_min:=minn;
end;
 
function find_max:PList;
var curr, maxx:PList;
x:integer;
begin
 curr:=head;
 x:=curr^.info;
 
 repeat
  if curr^.info<x then begin x:=curr^.info; maxx:=curr; end;
 until curr^.next = nil;
 
 find_max:=maxx;
end;
 
begin{program}
  ClrScr;
  MakeList(head,tail);
  writeln('исходный список');
  PrintList(head,tail);
  minel:=find_min;
  writeln('minimum : ',minel^.info);
  maxel:=find_max;
  writeln('maximum : ',maxel^.info);
  writeln('полученный список');
  PrintList(head,tail);
  readkey;
end.{program}

uses crt;
type
PNode=^Node;
Node=record
 data:integer;
 next:PNode;
end;
var
Head,min,max:PNode;
i:integer;
 
procedure AddToSpis(var Head1:PNode;k:integer);
var
tmp:PNode;
begin
  if Head1=nil then
    begin
      New(Head1);
      tmp:=Head1;
    end
  else
     begin
       tmp:=Head1;
         while tmp^.next <> nil do
           tmp:=tmp^.next;
         New(tmp^.next);
         tmp:=tmp^.next;
     end;
  tmp^.next:=nil;
  tmp^.data:=k;
end;
procedure Print(Head1:PNode);
begin
   while Head1 <> nil do
     begin
       write(Head1^.data:4);
       Head1:=Head1^.next;
     end;
end;
procedure FreeSpis(var Head1:PNode);
var
tmp:PNode;
begin
  while Head1 <> nil do
     begin
       tmp:=Head1;
       Head1:=Head1^.next;
       Dispose(tmp);
     end;
end;
procedure SearchAndChange(var Head1:PNode);
var
min,max,tmp,tmp1:PNode;
k:integer;
begin
  min:=Head1;
  max:=Head1;
  tmp1:=Head1;
    while tmp1^.next <> nil do
      begin
        tmp:=tmp1^.next;
          if tmp^.data > max^.data then
             max:=tmp;
          if tmp^.data < min^.data then
             min:=tmp;
        tmp1:=tmp1^.next;
      end;
begin
tmp1:=head;
while (min^.data>max^.data) do
  begin
  tmp1:=tmp1^.next;
  end;
dispose(tmp1);
end;
 
end;

program Project1;
 
type
  {Тип основных данных.}
  TData = Integer;
  {Указатель на элемент списка.}
  TPElem = ^TElem;
  {Элемент списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
  {Список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;
 
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Init(var aL : TDList);
begin
  aL.PFirst := nil;
  aL.PLast := nil;
end;
 
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
  PNew : TPElem;
begin
  New(PNew);
  PNew^.Data := aData;
  PNew^.PNext := nil;
  if aL.PFirst = nil then
    aL.PFirst := PNew
  else
    aL.PLast^.PNext := PNew;
  aL.PLast := PNew;
end;
 
{Освобождение памяти, занятой под список.}
procedure ListFree(var aL : TDList);
var
  PCur, PDel : TPElem;
begin
  PCur := aL.PFirst;
  while PCur <> nil do begin
    PDel := PCur;
    PCur := PCur^.PNext;
    Dispose(PDel);
  end;
  Init(aL);
end;
 
{Распечатка всего списка.}
procedure LWriteln(var aL : TDList);
var
  PCur : TPElem;
  i : Integer;
begin
  PCur := aL.PFirst;
  i := 0;
  while PCur <> nil do begin
    Inc(i);
    if i > 1 then Write(', ');
    Write(PCur^.Data);
    PCur := PCur^.PNext;
  end;
  if i = 0 then
    Writeln('Список пуст.')
  else
    Writeln;
end;
 
{Поиск первого наименьшего и последнего наибольшего элементов.
Процедура возвращает:
aPMin, aPMax - указатели на первый наименьший элемент и на последний
наибольший элементы.
aDir = True - если элемент aPMin расположен левее, чем aPMax.
aDir = False - если элемент aPMin расположен правее, чем aPMax.
Если в списке только один элемент, то он будет первым наименьшим
и одновременно - последним наибольшим. В этом случае aDir = True.}
procedure FindMinMax(const aL : TDList; var aPMin, aPMax : TPElem; var aDir : Boolean);
var
  PCur : TPElem;
begin
  if aL.PFirst = nil then Exit;
 
  aDir := True;
  PCur := aL.PFirst;
  aPMin := PCur;
  aPMax := PCur;
  PCur := PCur^.PNext;
  while PCur <> nil do begin
    if PCur^.Data < aPMin^.Data then begin
      aPMin := PCur;
      aDir := False;
    end;
    if PCur^.Data >= aPMax^.Data then begin
      aPMax := PCur;
      aDir := True;
    end;
    PCur := PCur^.PNext;
  end;
end;
 
{Удаление из списка элементов, которые расположены между элементами aP1 и aP2.}
function Del(var aP1, aP2 : TPElem; const aDir : Boolean) : Integer;
var
  PCur, PDel, P1, P2 : TPElem;
  Cnt : Integer;
begin
  Cnt := 0; {Количество удалённых элементов.}
  if aP1 = aP2 then begin
    Del := 0;
    Exit;
  end;
  {Определяем указатели P1 и P2 таким образом, чтобы указатель P1 указывал
  на элемент, который расположен левее элемента, на который указывает
  указатель P2.
  Если aDir = True, значит aP1 расположен левее, чем aP2.
  Если aDir = False, значит aP1 расположен правее, чем aP2.}
  if aDir then Begin
    P1 := aP1;
    P2 := aP2;
  end else begin
    P1 := aP2;
    P2 := aP1;
  end;
  {Удаляем элементы, которые расположены между элементами P1 и P2.}
  PCur := P1^.PNext;
  while PCur <> P2 do begin
    PDel := PCur;
    PCur := PCur^.PNext;
    Dispose(PDel);
    Inc(Cnt);
  end;
  {Связываем элементы P1 и P2.}
  P1^.PNext := P2;
  Del := Cnt;
end;
 
{Добавление элементов в список.}
procedure WorkAdd(var aL : TDList);
var
  S : String;
  Data : TData;
  Code : Integer;
begin
  Writeln('Добавление элементов в список.');
  Writeln('Ввод каждого значения завершайте нажатием Enter.');
  Writeln('Чтобы прекратить ввод, оставьте пустую строку и нажмите Enter.');
  repeat
    Write('Элемент: ');
    Readln(S);
    if S <> '' then begin
      Val(S, Data, Code);
      if Code = 0 then
        Add(aL, Data)
      else
        Writeln('Неверный ввод. Повторите.');
    end;
  until S = '';
  Writeln('Ввод элементов списка завершён.');
end;
 
var
  L : TDList;
  PMin, PMax : TPElem;
  Dir : Boolean;
  Cmd, Cnt : Integer;
begin
  {Начальная инициализация списка.}
  Init(L);
 
  repeat
    {Меню.}
    Writeln('---Выберите действие:');
    Writeln('1: Добавление элементов в список.');
    Writeln('2: Распечатка всего списка.');
    Writeln('3: Удаление элементов между первым наименьшим и последним наибольшим.');
    Writeln('4: Очистка списка.');
    Writeln('5: Выход.');
    Write('---Введите команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(L);
      2:
      begin
        Writeln('Содержимое списка:');
        LWriteln(L);
      end;
      3:
        if L.PFirst <> nil then begin
          FindMinMax(L, PMin, PMax, Dir);
          Cnt := Del(PMin, PMax, Dir);
          Writeln('Первый наименьший элемент: ', PMin^.Data);
          Writeln('Последний наибольший элемент: ', PMax^.Data);
          Writeln('Удалено элементов: ', Cnt);
          Writeln('Список после обработки:');
          LWriteln(L);
        end else begin
          Writeln('Список пуст. Действие отменено.');
        end;
      4, 5:
      begin
        ListFree(L);
        Writeln('Память, выделенная для списка, освобождена (список очищен).');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
  until Cmd = 5;
 
  Writeln('Работа программы завершена. Для выхода нажмите Enter.');
  Readln;
end.