Lab 11

program Project11;
{Дана матрица B, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn
по правилу:
Xi=0, если все элементы i-гo столбца и i-й строки матрицы меньше 1, иначе Xi=l.

Найти также произведение всех элементов матрицы.}

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const
    Nmass=10;

type
    mass = array [1..Nmass] of shortint;
    matr = array [1..Nmass,1..Nmass] of shortint;

procedure getConsole;
    begin
        SetConsoleCP(1251);
        SetConsoleOutputCP(1251);
    end;

procedure checkFiles (var fin01,fin02,fin03,fout: text); //проверка файлов
    begin
        if (ParamCount = 0) then
            begin
                writeln ('Либо программа только скомпилирована, либо текстовые файлы не привязаны...');
                readln;
                halt
            end;
        assign(fin01,ParamStr(1));
        assign(fin02,ParamStr(2));
        assign(fin03,ParamStr(3));
        assign(fout,ParamStr(4));
        {$I-}Reset(fin01);{$I+}
        if IOResult<>0 then
            begin
                writeln('Ошибка при окрытии первого входного файла');
                readln;
                halt
            end;
        {$I-}Reset(fin02);{$I+}
        if IOResult<>0 then
            begin
                writeln('Ошибка при окрытии второго входного файла');
                close(fin01);
                readln;
                halt
            end;
        {$I-}Reset(fin03);{$I+}
        if IOResult<>0 then
            begin
                writeln('Ошибка при окрытии третьего входного файла');
                close(fin01);
                close(fin02);
                readln;
                halt
            end;
        {$I-}Rewrite(fout);{$I+}
        if IOResult<>0 then
            begin
                writeln('Ошибка при создании выходного файла');
                close(fin01);
                close(fin02);
                close(fin03);
                readln;
                halt
            end;
    end;

function checkN (var fin01:textfile; var NAname,NBname,NCname: string; var n:shortint):byte; //проверка N на читабельность и диапазон
    var
        errN: byte;
    begin
        errN:=0;
        {$I-}readln(fin01, n);{$I+}
        if (IOResult <> 0) then
            begin
                writeln('Ошибка при чтении n');
                inc(errN);
                readln;
                halt
            end;
        if (n<1)and (errN=0) or (n>Nmass)and (errN=0) then
            begin
                writeln('N выходит за диапазон условленных значений');
                inc(errN);
                readln;
                halt
            end;
        result:=errN;
    end;

procedure task8 (var fin,fout: textfile; massname,matrname: string; out b: matr; out c: mass; n: shortint); // основная задача
    var
        i,j: shortint;
        flag: boolean;
{Дана матрица B, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn по правилу: Xi=0, если
все элементы i-гo столбца и i-й строки матрицы меньше 1, иначе Xi=l. Найти также произведение всех
элементов матрицы.}
    begin
       for i := 1 to n do
           begin
              for j := 1 to n do
                  read(fin, b[i,j]);
                  readln (fin);
           end;
       i:=1;
       while i<=n do
             begin
                flag:=true;
                j:=1;
                while j<=n do
                      begin
                         if (b[i,j]>=1) or (b[j,i]>=1) then
                            flag:=false;
                            inc(j);
                      end;
                if flag=true then
                   c[i]:=0
                else
                   c[i]:=1;
                inc(i);
             end;
    end;

function prodMatr (b:matr; n:shortint):integer; //счет произведения элементов матрицы
    var
        i,j: shortint;
    begin
        result:=1;
        for i:=1 to n do
            for j:=1 to n do
                result:=result*b[i,j];
    end;

procedure checkprod(var fout:text; matrname:string; prod:integer);
    begin
        if (prod=0) then
            writeln(fout,'Произведение элементов матрицы ',matrname,' равно нулю')
        else
            writeln (fout,'Произведение элементов матрицы ',matrname,' равно ',prod);
    end;

procedure task11(var fout: textfile; prod1,prod2,prod3: integer); //сравнение произведений массивов
    begin
        if (prod1<prod2) and (prod1<prod3) then
            writeln (fout,'Произведение элементов матрицы A наименьшее')
        else
            if (prod2<prod1) and (prod2<prod3) then
                writeln (fout,'Произведение элементов матрицы B наименьшее')
            else
                if (prod3<prod2) and (prod3<prod1) then
                    writeln (fout,'Произведение элементов матрицы C наименьшее')
                else
                    if (prod1=prod2)and (prod2<prod3) then
                        writeln (fout,'Произведения элементов первой и второй матриц равны и минимальны')
                    else
                        if (prod2=prod3) and (prod3<prod1) then
                            writeln (fout,'Произведения элементов второй и третьей матриц равны и минимальны')
                        else
                            if (prod1=prod3) and (prod1<prod2) then
                                writeln (fout,'Произведения элементов первой и третьей матриц равны и минимальны')
                            else
                                if (prod1=prod2) and (prod2=prod3) then
                                    writeln (fout,'Произведения элементов матриц равны');
    end;

procedure outputForm (var fout: textfile; matrname,massname: string;
                      const b: matr;
                      const c: mass; n:shortint);
    var
        i,j: shortint;
    begin
        writeln (fout);
        writeln(fout,'Размер матрицы и массива(',matrname,',',massname,'): ',n);
        writeln(fout,'Введённая матрица: ');
        writeln(fout,matrname,': ');
        for i:=1 to n do
            begin
                for j:=1 to n do
                    write (fout,b[i,j],' ');
                    writeln(fout)
            end;
        writeln (fout, 'Введённый массив: ');
        writeln(fout,massname,': ');
        for i:=1 to n do
            write(fout,c[i],' ');
        writeln (fout);
    end;

procedure closePr (var fin01,fin02,fin03,fout: text); //просто выход из программы
    begin
        writeln('...');
        Close(fin01);
        close(fin02);
        close(fin03);
        Close(fout);
        readln;
        halt
    end;

var
    na,nb,nc: ShortInt;
    prod1,prod2,prod3: integer;
    a,b,c: matr;
    ac,bc,cc: mass;
    fin01,fin02,fin03,fout: textfile;
    Aname, ACname, Bname, BCname, Cname, CCname,NAname,NBname,NCname: string;
begin
    Aname:='A';
    Bname:='B';
    Cname:='C';
    ACname:='AC';
    BCname:='BC';
    CCname:='CC';
    NAname:='na';
    NBname:='nb';
    NCname:='nc';

    getConsole();

    checkFiles(fin01,fin02,fin03,fout);

    checkN(fin01,NAname,NBname,NCname,na);
    checkN(fin02,NAname,NBname,NCname,nb);
    checkN(fin03,NAname,NBname,NCname,nc);

    {task8 (var fin,fout: textfile; massname,matrname: string; out b: matr; out c: mass; n: shortint))}
    task8(fin01,fout,Aname,ACname,a,ac,na);
    task8(fin02,fout,Bname,BCname,b,bc,nb);
    task8(fin03,fout,Cname,CCname,c,cc,nc);

    writeln(fout,'Лабораторная работа №11':20);

    outputForm(fout,Aname,ACname,a,ac,na);
    outputForm(fout,Bname,BCname,b,bc,nb);
    outputForm(fout,Cname,CCname,c,cc,nc);
    writeln(fout);

    {prodMatr (b:matr; n:shortint):integer}
    prod1:=prodMatr(a,na);
    prod2:=prodMatr(b,nb);
    prod3:=prodMatr(c,nc);

    {checkprod(var fout:text; matrname:string; prod:integer)}
    checkprod(fout,Aname,prod1);
    checkprod(fout,Bname,prod2);
    checkprod(fout,Cname,prod3);

    writeln(fout);

    {task11(var fout: textfile; prod1,prod2,prod3: integer}
    task11(fout,prod1,prod2,prod3);

    closePr(fin01,fin02,fin03,fout);
    readln;
end.