program Test2var2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils;

type
   TMatrix = array of array of Integer;
   TIntArr = array of Integer;
const
   StartMessage = 'This program places the lines in ascending order of the number of zero elements.';
   Example = '"Your_file_name.txt"';

//ввод имени файла
function InputName: string;
var
   FileName: string;
   IsCorrectName: Boolean;
begin
   repeat
      Writeln('Enter name of file in format: ', Example);
      IsCorrectName := False;
      Readln(FileName);
      if FileExists(FileName) then
         IsCorrectName := True
      else
         Writeln('File is not exist. Please, follow instruction and enter right name of file ');
   until IsCorrectName;
   InputName := FileName;
end;

//находим размерность, если квадрат
function FindDimensionN(var Input: TextFile): Integer;
var
   i, j, Order, Symbol: Integer;
   IsCorrect: Boolean;
begin
   Reset(Input);
   IsCorrect := True;
   i := 0;
   Order := 0;
   while (not Eof(Input) and (IsCorrect)) do
   begin
      j := 0;
      while ((not EoLn(Input)) and IsCorrect) do
      begin
         try
            Read(Input, Symbol);
         except
            IsCorrect := False;
            Write('Error. Your matrix must consist of integers. Correct your' +
                ' file. Press enter to continue...');
         end;
         Inc(j);
      end;
      if Order = 0 then
         Order := j;
      if (Order <> j)or (Order < 2) then
      begin
         IsCorrect := False;
         Writeln('Your matrix must be square and order must be greater than 2. Correct your file and start again');
      end;
      Inc(i);
      Readln(Input);
   end;
   Close(Input);
   if (Order <> i) or (not IsCorrect)
    then
      Order := -1;
   FindDimensionN := Order;
end;

//ввод матрицы из файла
function EnterMatrix(Order: Integer; var Input: TextFile):TMatrix;
var
   i, j: Integer;
   Matrix: TMatrix;
begin
   Reset(Input);
   SetLength(Matrix, Order, Order);
   Dec(Order);
   for i := 0 to Order do
   begin
      for j:= 0 to Order do
         Read(Input, Matrix[i,j]);
      Readln(Input);
   end;
   Close(Input);
   EnterMatrix := Matrix;
end;

//считает ноли в строке матрицы
function CountZero(const MatrixStr: TIntArr): Integer;
var
   Counter, i, MaxIndex: Integer;

begin
   Counter := 0;
   MaxIndex := High(MatrixStr);
   for i := 0 to MaxIndex do
   begin
      if MatrixStr[i] = 0 then
         Inc(Counter);
   end;
   CountZero := Counter;
end;

function GetCountersArr(const Matrix: TMatrix): TIntArr;
var
   CounterArr,  MatrixStr: TIntArr;
   i, j, MaxIndex: Integer;
begin
   MaxIndex := High(Matrix);
   SetLength(MatrixStr, MaxIndex + 1);
   SetLength(CounterArr, MaxIndex + 1);
   for i := 0 to MaxIndex do
   begin
      for j := 0 to MaxIndex do
         MatrixStr[j] := Matrix [i, j];
      CounterArr[i] := CountZero(MatrixStr);
   end;
   GetCountersArr := CounterArr;
end;

//переставляет строки матрицы как в условии
function ChangeMatrix( Matrix: TMatrix; CounterArr: TIntArr): TMatrix;
var
   IsEnd: Boolean;
   i, j, MaxIndex, Optim, TempCounter, TempMatrixEl: Integer;
begin
   MaxIndex := High(Matrix);
   Optim := MaxIndex - 1;
   repeat
      IsEnd := True;
      for i := 0 to Optim do
      begin
         if CounterArr[i] > CounterArr[i + 1] then
         begin
            for j := 0 to MaxIndex do
            begin
               TempMatrixEl := Matrix[i, j];
               Matrix[i, j] := Matrix[i + 1, j];
               Matrix[i + 1, j] := TempMatrixEl;
            end;
            TempCounter := CounterArr[i];
            CounterArr[i] := CounterArr[i + 1];
            CounterArr[i + 1] := TempCounter;
            IsEnd := False;
         end;
      end;
      Dec(Optim);
   until IsEnd;
   ChangeMatrix := Matrix;
end;

//вывод матрицы в файл
procedure FileOutput(Matrix: TMatrix);
var
   i, j, MaxIndex: Integer;
   Output: TextFile;
   FileName: string;

begin
   Writeln('Enter name of file for output. For example: ', Example);
   Readln(FileName);
   AssignFile(Output, FileName);
   MaxIndex := High(Matrix);
   Rewrite(Output);
   for i := 0 to MaxIndex do
   begin
      for j := 0 to MaxIndex do
         Write(Output, Matrix[i, j], ' ');
      Writeln(Output);
   end;
   CloseFile(Output);
end;

procedure ConsoleOutput (Matrix: TMatrix);
var
   i, j, MaxIndex: Integer;
begin
   MaxIndex := High(Matrix);
   for i := 0 to MaxIndex do
   begin
      for j := 0 to MaxIndex do
         Write(Matrix[i, j],' ');
      Writeln;
   end;
end;

procedure Main;
var
   Order: Integer;
   FileName: string;
   Matrix: TMatrix;
   Input: TextFile;
   IsValidInput: Boolean;
   CounterArr: TIntArr;

begin
   repeat
      Writeln(StartMessage);
      FileName := InputName;
      Assign(Input, FileName);
      IsValidInput := True;
      Order := FindDimensionN(Input);
      if Order = -1 then
         IsValidInput:= False;
   until IsValidInput;
   Matrix := EnterMatrix(Order, Input);
   Writeln('Your start martix: ');
   ConsoleOutput(Matrix);
   CounterArr := GetCountersArr(Matrix);
   Matrix := ChangeMatrix(Matrix, CounterArr);
   FileOutput(Matrix);
   Writeln('Your final martix: ');
   ConsoleOutput(Matrix);
   Writeln;
   Writeln('Press enter to exit...');
   Readln;
end;

begin
   Main;
end.