Поворот на 90 градусов по часовой стрелке и против без использования дополнительного массива

uses crt;

const n=6;

var a : array[1..n,1..n] of integer;

    i,j,p,x : integer;

begin

clrscr;

writeln('Исходная матрица:');

for i:=1 to n do

  begin

    for j:=1 to n do

      begin

       a[i,j] := 10*i+j;

       write(a[i,j]:4);

      end;

    writeln;

  end;

p := n div 2;

{поворот по часовой стрелке}

for i:=1 to p do

for j:=i to n-i do

  begin

    x := a[i,j];

    a[i,j] := a[n-j+1,i];

    a[n-j+1,i] := a[n-i+1,n-j+1];

    a[n-i+1,n-j+1] := a[j,n-i+1];

    a[j,n-i+1] := x;

  end;

writeln('Поворот на 90 градусов по часовой стрелке:');

for i:=1 to n do

  begin

    for j:=1 to n do

    write(a[i,j]:4);

    writeln;

  end;

{поворот против часовой стрелки}

for i:=1 to p do

for j:=i to n-i do

 begin

  x:=a[i,j];

  a[i,j]:=a[j,n-i+1];

  a[j,n-i+1]:=a[n-i+1,n-j+1];

  a[n-i+1,n-j+1] := a[n-j+1,i];

  a[n-j+1,i]:=x;

 end;

writeln('Поворот на 90 градусов против часовой стрелки:');

for i:=1 to n do

  begin

    for j:=1 to n do

    write(a[i,j]:4);

    writeln;

  end;

readln

end.

Удаление элемента в одномерном массиве

var

   a:array[1..100] of integer;

   i,m,n:integer;

begin

 readln(n);    {ñ÷èòûâГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ}

 for i:=1 to n do

  read(a[i]);

 writeln('ГЊГ*Г±Г±ГЁГў');

 for i:=1 to n do

  write(a[i],' ');

 writeln;

 writeln('Ïîñëå ГіГ¤Г*ëåГ*ГЁГї');

 m:=0;

 for i:=1 to n do

  if (a[i]=0) then inc(m) else a[i-m]:=a[i]; {ГіГ¤Г*ëÿåì ýëåìåГ*ГІГ»}

 dec(n,m);  {óìåГ*ГјГёГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ Г¬Г*Г±Г±ГЁГўГ* Г*Г* êîëè÷åñòâî Г*óëåâûõ ýëåìåГ*òîâ}

 for i:=1 to n do

  write(a[i],' '); {âûâîä Г*Г* ГЅГЄГ°Г*Г*}

 readln

end.

Вставка элемента в одномерный массив

var

   a:array[1..100] of integer;

   i,x,n,nom:integer;

begin

 write('Ââåäèòå êîëè÷åñòâî ýëåìåГ*òîâ=');

 readln(n);

 for i:=1 to n do

  read(a[i]);  {ñ÷èòûâГ*ГҐГ¬ ýëåìåГ*ГІГ»}

 write('Ââåäèòå ÷èñëî, êîòîðîå Г*ГіГ¦Г*Г® ГўГ±ГІГ*ГўГЁГІГј=');

 readln(x);

 write('Ââåäèòå Г*îìåð ÿ÷åéêè, Гў êîòîðóþ ГҐГЈГ® Г*Г*äî ïîìåñòèòü=');

 readln(nom);

 writeln('ГЊГ*Г±Г±ГЁГў');

 for i:=1 to n do

  write(a[i],' ');

 writeln;

 writeln('Ïîñëå ГўГ±ГІГ*ГўГЄГЁ');

 for i:=n+1 downto nom+1 do

  a[i]:=a[i-1]; {ñäâèãГ*ГҐГ¬ ГўГ±ГҐ ýëåìåГ*ГІГ» ГўГЇГ°Г*ГўГ®}

 a[nom]:=x;    {ГўГ±ГІГ*âëÿåì ÷èñëî}

 for i:=1 to n+1 do

  write(a[i],' ');

 readln

end.

Удаление всех строк и столбцов, содержащих хоть 1 ноль.

Также положительные, отрицательные и т.д.

uses crt;

var a:array[1..10,1..9] of integer;

    b:array[1..9] of byte;

    m,n,i,j,f,p,k:byte;

begin

clrscr;

randomize;

n:=10;

m:=9;

writeln('Исходная матрица:');

for i:=1 to n do

 begin

  for j:=1 to m do

   begin

    a[i,j]:=random(10);

    write(a[i,j]:3);

   end;

  writeln;

 end;

writeln;

{номера столбцов с нолями}

f:=0;

for j:=1 to m do

 begin

  k:=0;

  for i:=1 to n do

  if a[i,j]=0 then

   begin

    k:=1;

    f:=1;

   end;

  b[j]:=k;

 end;

if f=0 then write('В матрице нет нолей!')

else

 begin

  {удаление строк с нолем}

  i:=n;{начнем с конца}

  while(i>=1)and(n>0) do

   begin

    k:=0;

    j:=1;

    while(j<=m)and(k=0) do

    if a[i,j]=0 then k:=1

    else j:=j+1;

    if k=1 then{если есть ноль}

     begin

      f:=f-1;{вычитаем строку}

      if i=n then {если строка на этот момент последняя}

       begin

        n:=n-1;{обрезаем}

        i:=i-1;{верх}

       end

      else {если не последняя}

       begin

        for k:=i to n-1 do{от этой строки до предпоследней}

        for p:=1 to m do{всем элементам строк}

        a[k,p]:=a[k+1,p];{присваиваем значения нижней}

        n:=n-1;{уменьшаем количество}

       end;

     end

    else i:=i-1;{если нет нолей, вверх}

   end;

if n=0 then writeln('Все строки и столбцы удалены!')

else{если остались строки, удаляем столбцы}

 begin

  f:=m;{начнем с конца}

  for i:=m downto 1 do{в обратном порядке читаем массив номеров}

  if b[i]=1 then{если есть ноль}

   begin

    if i=f then{и последний на данный момент, также как строки}

      begin

       m:=m-1;

       f:=f-1;

      end

    else {если не последний, тоже как строки}

     begin

      for k:=i to m-1 do

      for p:=1 to n do

      a[p,k]:=a[p,k+1];

      m:=m-1;

     end;

   end;

  writeln('Матрица после сжатия:');

  for i:=1 to n do

   begin

    for j:=1 to m do

    write(a[i,j]:3);

    writeln;

   end;

 end;

 end;

readln

end.