ANTICHAT - Показать сообщение отдельно - [Delphi]/[Pascal] Задай вопрос, получи ответ

Цитата:

Сообщение от Thenno

А необходимо переставлять эелементы в строке, или сами строки?

Цитата:

Сообщение от NTFF

Перестановкой строк добиться расположение всех нулей по главной диагонали.

Цитата:

Сообщение от NTFF

в каждом столбце и каждой строке матрицы содержица строго по одному нулевому элементу. Перестановкой строк добиться расположение всех нулей по главной диагонали. В программе должна присутствовать проверка чтоб в строке был строго один ноль, в противном случае цикл не выполняться. матрица 5*5 пользователь сам ее вводит?

Как я понял из сегодняшнего разговора, генерировать матрицу не нужно, а сортировка не выполняется вообще, если есть неправильная строка. Тогда вот код:

Код:

PROGRAM PMatrix;
uses
    Crt;

const
     N = 5;

Var
   Matrix:      Array [1..N,1..N] of byte;
   Indexes:     set of byte;
   counter:     byte;

function CheckMatrix: boolean;
var
   i, j:           byte;
begin
     CheckMatrix := false;
     Indexes := [];
     for i := 1 to N do
         begin
              counter := 0;
              for j := 1 to N do
                  begin
                       if (Matrix[i,j] = 0) then
                          begin
                               inc(counter);
                               if (j in Indexes) then
                                  exit;
                               Indexes := Indexes + [j];
                          end;
                  end;
              if (counter <> 1) then
                 exit;
         end;
     CheckMatrix := true;
end;


procedure ChangeLines(index1, index2: byte);
var
   tmp:         byte;
   i:           byte;
begin
     for i := 1 to N do
         begin
              tmp := Matrix[index1,i];
              Matrix[index1,i] := Matrix[index2,i];
              Matrix[index2,i] := tmp;
         end;

end;


procedure SortMatrix;
var
   i, j:        byte;
   tmp:         boolean;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] = 0) then
                     begin
                          ChangeLines(i,j);
                          break;
                     end;
         end;
end;


procedure ShowMatrix;
var
   i, j:        byte;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] < 10) then
                     write(' ', Matrix[i,j], ' ')
                  else
                      write(Matrix[i,j], ' ');
              writeln
         end;
end;


var
   i, j:        byte;
   chose:       char;
begin
     clrscr;
     Indexes := [];
     for i := 1 to N do
         for j := 1 to N do
             begin
                  write('Matrix[',i,',',j,'] = ');
                  readln(Matrix[i,j]);
             end;

     writeln;
     ShowMatrix;
     writeln;

     if CheckMatrix then
         SortMatrix;

     ShowMatrix;
     readln;
end.