Даны действительные числа а1.а30. Оставить без изменений последовательность, если она упорядочена по не убыванию и не возрастанию, иначе - удалить и

program pr1;
{$APPTYPE CONSOLE}
uses
  SysUtils;
 
const n=30;
var i,m,j:Integer;
    f:Boolean;
    a:array[1..n] of Real;
 
 
   begin
    for i:=1 to n do
     Readln(a[i]);
 
    for i:=1 to n do
     begin
      if  ((a[i]<a[i+1]) and (a[i]<a[i+2]))
       then f:=True
       else f:=False;
     end;
      for i:=1 to n do
       if (a[i]>a[i+1]) and (a[i]>a[i+2])
        then f:=True
        else f:=False;
 
    if (f=True) 
     then
      begin
        m:=n;
        i:=1;
       while i<=m do
        if i mod 4 = 0
         then
          begin
            for j:=i to m-1 do
             a[j]:=a[j+1];
            m:=m-1;
            i:=i+1;
          end
         else i:=i+1;
        for i:=1 to m do
         Writeln(a[i]:0:3)
      end
     else
      begin
       Writeln;
       for i:=1 to n do
        Writeln(a[i]:0:3);
      end;
    Readln;
end.

program pr1;
 
const n=30;
var i,m,j:Integer;
    f:Boolean;
    a:array[1..n] of Real;
    vmode:byte;
 
 
   begin
   writeln;
   write('chose mode(1-4): ');
   readln(vmode);
    for i:=1 to n do
        case vmode of
    1: Readln(a[i]); {vvod}
    2: a[i]:=i;  {up sorted}
    3: a[i]:=n-i+1; {down sorted}
    4: a[i]:=random(100);  {unsorted}
    end;
    for i:=1 to n do writeln('a[',i,']: ',a[i]:0:3);  {show array}
    readln;
 
 
    for i:=1 to n-1 do
     begin
      if  a[i]<a[i+1]
       then f:=True
       else begin f:=False; break;end;
 end;
     {writeln('f=',f);
    readln;}
     if f=false then
      for i:=1 to n-1 do
       if a[i]>a[i+1]
        then f:=True
        else begin f:=False; break;end;
  {  writeln('f=',f);
    readln;}
 
 
    if (f=false)
     then
      begin
        m:=n;
        i:=1;
       while i<=m do
        if i mod 4 = 0
         then
          begin
            for j:=i to m-1 do
             a[j]:=a[j+1];
            m:=m-1;
            i:=i+1;
          end
         else i:=i+1;
        for i:=1 to m do
         Writeln('a[',i,']: ',a[i]:0:3)
      end
     else
      begin
       Writeln;
       for i:=1 to n do
        Writeln('a[',i,']: ',a[i]:0:3);
      end;
    Readln;
end.