Напишите программу ** Паскале)

Question

Напишите программу на Паскале)

---

Answer 1

Const
   N = 13;
Var
   A:array[1..N] of integer;
   i,Max:integer;
   P:real;
Begin
Write('Исходный массив: ');
For i:= 1 to N do
    Read(A[i]);
Max:=1;
For i:= 2 to N do
    if A[Max]WriteLn('Max(A) = A[',Max,'] = ',A[Max]);
if Abs(N div 2+1 -Max) > 1 then
   Begin
   P:=1;
   For i:=N div 2+1 to Max-1 do
       P:=P*A[i];
   For i:= Max+1 to N div 2-1 do
       P:=P*A[i];
   WriteLn('P = ',P);
   End
else
   Begin
   if Abs(N div 2+1 -Max) = 1 then WriteLn('Максимальный и срединный элементы стоят впритык друг к другу')
   else WriteLn('Максимальный элемент находится в середине');
   End
End.



Const
   D = 13;
Type
   Mass = array[1..D] of integer;
Function ABC(Var A:Mass):integer;
Var
   i,n,k:integer;
Begin
result:=D;
i:=2;
Repeat
k:=1;
While (A[i-1]=A[i])and(i   Begin
   i:=i+1;
   k:=k+1;
   End;
if (i=result)and(A[i-1]=A[i]) then
   Begin
   result:=result-k-1;
   k:=1;
   End;
if k>1 then
   Begin
   For n:= i to result do
       A[n-k]:=A[n];
   i:=1;
   result:=result-k;
   End;
i:=i+1;
Until (i>result);
End;

Var
   A:Mass;
   i,o,k:integer;
Begin
Write('Исходный массив: ');
For i:= 1 to D do
    Read(A[i]);
WriteLn;
Write('"Очищеный" массив: ');
For i:= 1 to ABC(A) do
    Write(A[i],' ')
End.