Транспонировать квадрат,в нижнем левом углу которого находится минимальный элемент

[zidan671]

Помогите пожалуйста....
Дана матрица 5*5)необходимо разработать модуль,содержащий процедуры и функции,решающие следующие задачи:
Транспонировать квадрат,в нижнем левом углу которого находится минимальный элемент матрицы

[Sazary]

Вот вам процедура, которая это делает:

procedure transkvadr(M : matrix; n : integer);
 var i,j,mi,mj,len,k : integer;
 begin
 mi :=1; mj:=1;
 for i:=1 to n do
  for j:=1 to n do
   if M[i,j]<M[mi,mj] then
    begin
    mi := i;
    mj := j;
    end;

 len := 1;
 for i:=mi downto 1 do
  inc(len);
 k := 1;
 for j:=mj to n do
  inc(k);
 if k<len then len := k;
 {----------}
 for i:=mi-len+1 to mi do
  for j:=i to mj+len-1 do
   begin
   k := M[i,j];
   M[i,j] := M[j,i];
   M[j,i] := k;
   end;
 {----------}

 for i:=1 to n do
  begin
  for j:=1 to n do
   write(M[i,j]:4);
  writeln;
  end;
 writeln;
 end;

Здесь тип matrix должен быть объявлен как:

type matrix = array[1..100,1..100] of integer;

n - порядок матрицы.

Пример программы:

uses crt;
type matrix = array[1..100,1..100] of integer;

const n=5;
var
a : matrix;
i,j : integer;

procedure transkvadr(M : matrix; n : integer);
 var i,j,mi,mj,len,k : integer;
 begin
 mi :=1; mj:=1;
 for i:=1 to n do
  for j:=1 to n do
   if M[i,j]<M[mi,mj] then
    begin
    mi := i;
    mj := j;
    end;

 len := 1;
 for i:=mi downto 1 do
  inc(len);
 k := 1;
 for j:=mj to n do
  inc(k);
 if k<len then len := k;
 {----------}
 for i:=mi-len+1 to mi do
  for j:=i to mj+len-1 do
   begin
   k := M[i,j];
   M[i,j] := M[j,i];
   M[j,i] := k;
   end;
 {----------}

 for i:=1 to n do
  begin
  for j:=1 to n do
   write(M[i,j]:4);
  writeln;
  end;
 writeln;
 end;
{-----------}

begin
clrscr;
randomize;
for i:=1 to n do
 begin
 for j:=1 to n do
  begin
  a[i,j] := random(30);
  write(a[i,j]:4);
  end;
 writeln;
 end;
writeln;
writeln('-----------');
transkvadr(a,n);
readln;
end.

В модуль сами переделаете. В него нужно включить определение типа matrix и процедуру.

[zidan671]

Спасибо большое))!!!немного не понял что такое len?это необходимо для нахождения размерности квадрата?
и что такое inc(k)?просто в других лабах мы вроде такое не использовали

[capta1n]

unit matrica;

interface
 const
  size_matrix = 5;
 type
  item = array [1..size_matrix,1..size_matrix] of integer;
 function check ( var m : item; n1 : byte ) : boolean;
 procedure transport ( var m : item; n1 : byte);

implementation

 function check;
 var
  i,k,mem_row,mem_col : byte;
  min : integer;
 begin
   min:=m[1,1];
   for i:=1 to n1 do
    for k:=1 to n1 do
     if m[i,k]<min then
     begin
       mem_row:=i;
       mem_col:=k;
       min:=m[i,k]
     end;
   if (mem_row=n1) and (mem_col=1) then check:=true
                                   else check:=false
 end;

 procedure transport;
 var
  i,k : byte;
  buf : integer;
 begin
   for i:=1 to n1 do
    for k:=i to n1 do
    begin
      buf:=m[i,k];
      m[i,k]:=m[k,i];
      m[k,i]:=buf
    end
 end;

end.

Программа для теста юнита:

program prog;
uses matrica;
var
 a : item;
 i,k : byte;
 n : integer;
begin
  n:=size_matrix;
  randomize;
  for i:=1 to n do
   for k:=1 to n do a[i,k]:=random(10);
  a[n,1]:=-1;

  for i:=1 to n do
  begin
    for k:=1 to n do write (a[i,k],'|');
    writeln
  end;
  writeln;
  if check (a,n) then transport (a,n);

  for i:=1 to n do
  begin
    for k:=1 to n do write (a[i,k],'|');
    writeln
  end;
  readln
end.

[Sazary]

немного не понял что такое len?это необходимо для нахождения размерности квадрата?
и что такое inc(k)?

len - длина стороны квадрата.
inc(k) - можете заменить на
k := k + 1;

[zidan671]

Спасибо)теперь всё понятно)

[puporev]

Транспонировать квадрат,в нижнем левом углу которого находится минимальный элемент матрицы

Т.е. если есть матрица
1 1 1 1 1
2 2 2 2 2
3 0 3 3 3
4 4 4 4 4
5 5 5 5 5
То должна получиться
1 1 2 0 1
2 1 2 3 2
3 1 2 3 3
4 4 4 4 4
5 5 5 5 5
Что-то я этого не увидел этого ни в одной из предложенных программ.

[Sazary]

puporev, Премного благодарен! ) Действительно.. Как-то не заметил.

Исправленный вариант. Проверил несколько раз, вроде все так.

uses crt;
type matrix = array[1..100,1..100] of integer;

const n=5;
var
a : matrix;
i,j : integer;

procedure transkvadr(M : matrix; n : integer);
 var i,j,mi,mj,len,k : integer;
 begin
 mi :=1; mj:=1;
 for i:=1 to n do
  for j:=1 to n do
   if M[i,j]<M[mi,mj] then
    begin
    mi := i;
    mj := j;
    end;

 len := 0;
 for i:=mi downto 1 do
  inc(len);
 k := 0;
 for j:=mj to n do
  inc(k);
 if k<len then len := k;

  {----------}

 for i:=1 to len do
  for j:=i+1 to len do
   begin
   k := M[mi-len+i,mj+j-1];
   M[mi-len+i,mj+j-1] := M[mi-len+j,mj+i-1];
   M[mi-len+j,mj+i-1] := k;
   end;
 {----------}

 for i:=1 to n do
  begin
  for j:=1 to n do
   write(M[i,j]:4);
  writeln;
  end;
 writeln;
 end;
{-----------}

begin
clrscr;
randomize;
for i:=1 to n do
 begin
 for j:=1 to n do
  begin
  a[i,j] := random(40);
  write(a[i,j]:4);
  end;
 writeln;
 end;
writeln;

{ для проверки }
{for i:=1 to n do
 begin
 for j:=1 to n do
  begin
  a[i,j] := i;
  if (j=2) and (i=3) then a[i,j] := 0;
  write(a[i,j]:4);
  end;
 writeln;
 end;
          }
writeln('-----------');
transkvadr(a,n);
readln;
end.

[capta1n]

http://ru.wikipedia.org/wiki/Транспонированная_матрица

матрицу надо брать всю, а не кусок

[Sazary]

capta1n
Измените в вашей программе:

 a[n,1]:=-1;

на

a[3,1]:=-1;

и она перестанет работать.