SHARE
TWEET

Lab 11

Pohuyumer Jan 23rd, 2020 76 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Project11;
  2. {Дана матрица B, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn
  3. по правилу:
  4. Xi=0, если все элементы i-гo столбца и i-й строки матрицы меньше 1, иначе Xi=l.
  5.  
  6. Найти также произведение всех элементов матрицы.}
  7.  
  8. {$APPTYPE CONSOLE}
  9.  
  10. uses
  11.   SysUtils,
  12.   Windows;
  13.  
  14. const
  15.     Nmass=10;
  16.  
  17. type
  18.     mass = array [1..Nmass] of shortint;
  19.     matr = array [1..Nmass,1..Nmass] of shortint;
  20.  
  21. procedure getConsole;
  22.     begin
  23.         SetConsoleCP(1251);
  24.         SetConsoleOutputCP(1251);
  25.     end;
  26.  
  27. procedure checkFiles (var fin01,fin02,fin03,fout: text); //проверка файлов
  28.     begin
  29.         if (ParamCount = 0) then
  30.             begin
  31.                 writeln ('Либо программа только скомпилирована, либо текстовые файлы не привязаны...');
  32.                 readln;
  33.                 halt
  34.             end;
  35.         assign(fin01,ParamStr(1));
  36.         assign(fin02,ParamStr(2));
  37.         assign(fin03,ParamStr(3));
  38.         assign(fout,ParamStr(4));
  39.         {$I-}Reset(fin01);{$I+}
  40.         if IOResult<>0 then
  41.             begin
  42.                 writeln('Ошибка при окрытии первого входного файла');
  43.                 readln;
  44.                 halt
  45.             end;
  46.         {$I-}Reset(fin02);{$I+}
  47.         if IOResult<>0 then
  48.             begin
  49.                 writeln('Ошибка при окрытии второго входного файла');
  50.                 close(fin01);
  51.                 readln;
  52.                 halt
  53.             end;
  54.         {$I-}Reset(fin03);{$I+}
  55.         if IOResult<>0 then
  56.             begin
  57.                 writeln('Ошибка при окрытии третьего входного файла');
  58.                 close(fin01);
  59.                 close(fin02);
  60.                 readln;
  61.                 halt
  62.             end;
  63.         {$I-}Rewrite(fout);{$I+}
  64.         if IOResult<>0 then
  65.             begin
  66.                 writeln('Ошибка при создании выходного файла');
  67.                 close(fin01);
  68.                 close(fin02);
  69.                 close(fin03);
  70.                 readln;
  71.                 halt
  72.             end;
  73.     end;
  74.  
  75. function checkN (var fin01:textfile; var NAname,NBname,NCname: string; var n:shortint):byte; //проверка N на читабельность и диапазон
  76.     var
  77.         errN: byte;
  78.     begin
  79.         errN:=0;
  80.         {$I-}readln(fin01, n);{$I+}
  81.         if (IOResult <> 0) then
  82.             begin
  83.                 writeln('Ошибка при чтении n');
  84.                 inc(errN);
  85.                 readln;
  86.                 halt
  87.             end;
  88.         if (n<1)and (errN=0) or (n>Nmass)and (errN=0) then
  89.             begin
  90.                 writeln('N выходит за диапазон условленных значений');
  91.                 inc(errN);
  92.                 readln;
  93.                 halt
  94.             end;
  95.         result:=errN;
  96.     end;
  97.  
  98. procedure task8 (var fin,fout: textfile; massname,matrname: string; out b: matr; out c: mass; n: shortint); // основная задача
  99.     var
  100.         i,j: shortint;
  101.         flag: boolean;
  102. {Дана матрица B, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn по правилу: Xi=0, если
  103. все элементы i-гo столбца и i-й строки матрицы меньше 1, иначе Xi=l. Найти также произведение всех
  104. элементов матрицы.}
  105.     begin
  106.        for i := 1 to n do
  107.            begin
  108.               for j := 1 to n do
  109.                   read(fin, b[i,j]);
  110.                   readln (fin);
  111.            end;
  112.        i:=1;
  113.        while i<=n do
  114.              begin
  115.                 flag:=true;
  116.                 j:=1;
  117.                 while j<=n do
  118.                       begin
  119.                          if (b[i,j]>=1) or (b[j,i]>=1) then
  120.                             flag:=false;
  121.                             inc(j);
  122.                       end;
  123.                 if flag=true then
  124.                    c[i]:=0
  125.                 else
  126.                    c[i]:=1;
  127.                 inc(i);
  128.              end;
  129.     end;
  130.  
  131. function prodMatr (b:matr; n:shortint):integer; //счет произведения элементов матрицы
  132.     var
  133.         i,j: shortint;
  134.     begin
  135.         result:=1;
  136.         for i:=1 to n do
  137.             for j:=1 to n do
  138.                 result:=result*b[i,j];
  139.     end;
  140.  
  141. procedure checkprod(var fout:text; matrname:string; prod:integer);
  142.     begin
  143.         if (prod=0) then
  144.             writeln(fout,'Произведение элементов матрицы ',matrname,' равно нулю')
  145.         else
  146.             writeln (fout,'Произведение элементов матрицы ',matrname,' равно ',prod);
  147.     end;
  148.  
  149. procedure task11(var fout: textfile; prod1,prod2,prod3: integer); //сравнение произведений массивов
  150.     begin
  151.         if (prod1<prod2) and (prod1<prod3) then
  152.             writeln (fout,'Произведение элементов матрицы A наименьшее')
  153.         else
  154.             if (prod2<prod1) and (prod2<prod3) then
  155.                 writeln (fout,'Произведение элементов матрицы B наименьшее')
  156.             else
  157.                 if (prod3<prod2) and (prod3<prod1) then
  158.                     writeln (fout,'Произведение элементов матрицы C наименьшее')
  159.                 else
  160.                     if (prod1=prod2)and (prod2<prod3) then
  161.                         writeln (fout,'Произведения элементов первой и второй матриц равны и минимальны')
  162.                     else
  163.                         if (prod2=prod3) and (prod3<prod1) then
  164.                             writeln (fout,'Произведения элементов второй и третьей матриц равны и минимальны')
  165.                         else
  166.                             if (prod1=prod3) and (prod1<prod2) then
  167.                                 writeln (fout,'Произведения элементов первой и третьей матриц равны и минимальны')
  168.                             else
  169.                                 if (prod1=prod2) and (prod2=prod3) then
  170.                                     writeln (fout,'Произведения элементов матриц равны');
  171.     end;
  172.  
  173. procedure outputForm (var fout: textfile; matrname,massname: string;
  174.                       const b: matr;
  175.                       const c: mass; n:shortint);
  176.     var
  177.         i,j: shortint;
  178.     begin
  179.         writeln (fout);
  180.         writeln(fout,'Размер матрицы и массива(',matrname,',',massname,'): ',n);
  181.         writeln(fout,'Введённая матрица: ');
  182.         writeln(fout,matrname,': ');
  183.         for i:=1 to n do
  184.             begin
  185.                 for j:=1 to n do
  186.                     write (fout,b[i,j],' ');
  187.                     writeln(fout)
  188.             end;
  189.         writeln (fout, 'Введённый массив: ');
  190.         writeln(fout,massname,': ');
  191.         for i:=1 to n do
  192.             write(fout,c[i],' ');
  193.         writeln (fout);
  194.     end;
  195.  
  196. procedure closePr (var fin01,fin02,fin03,fout: text); //просто выход из программы
  197.     begin
  198.         writeln('...');
  199.         Close(fin01);
  200.         close(fin02);
  201.         close(fin03);
  202.         Close(fout);
  203.         readln;
  204.         halt
  205.     end;
  206.  
  207. var
  208.     na,nb,nc: ShortInt;
  209.     prod1,prod2,prod3: integer;
  210.     a,b,c: matr;
  211.     ac,bc,cc: mass;
  212.     fin01,fin02,fin03,fout: textfile;
  213.     Aname, ACname, Bname, BCname, Cname, CCname,NAname,NBname,NCname: string;
  214. begin
  215.     Aname:='A';
  216.     Bname:='B';
  217.     Cname:='C';
  218.     ACname:='AC';
  219.     BCname:='BC';
  220.     CCname:='CC';
  221.     NAname:='na';
  222.     NBname:='nb';
  223.     NCname:='nc';
  224.  
  225.     getConsole();
  226.  
  227.     checkFiles(fin01,fin02,fin03,fout);
  228.  
  229.     checkN(fin01,NAname,NBname,NCname,na);
  230.     checkN(fin02,NAname,NBname,NCname,nb);
  231.     checkN(fin03,NAname,NBname,NCname,nc);
  232.  
  233.     {task8 (var fin,fout: textfile; massname,matrname: string; out b: matr; out c: mass; n: shortint))}
  234.     task8(fin01,fout,Aname,ACname,a,ac,na);
  235.     task8(fin02,fout,Bname,BCname,b,bc,nb);
  236.     task8(fin03,fout,Cname,CCname,c,cc,nc);
  237.  
  238.     writeln(fout,'Лабораторная работа №11':20);
  239.  
  240.     outputForm(fout,Aname,ACname,a,ac,na);
  241.     outputForm(fout,Bname,BCname,b,bc,nb);
  242.     outputForm(fout,Cname,CCname,c,cc,nc);
  243.     writeln(fout);
  244.  
  245.     {prodMatr (b:matr; n:shortint):integer}
  246.     prod1:=prodMatr(a,na);
  247.     prod2:=prodMatr(b,nb);
  248.     prod3:=prodMatr(c,nc);
  249.  
  250.     {checkprod(var fout:text; matrname:string; prod:integer)}
  251.     checkprod(fout,Aname,prod1);
  252.     checkprod(fout,Bname,prod2);
  253.     checkprod(fout,Cname,prod3);
  254.  
  255.     writeln(fout);
  256.  
  257.     {task11(var fout: textfile; prod1,prod2,prod3: integer}
  258.     task11(fout,prod1,prod2,prod3);
  259.  
  260.     closePr(fin01,fin02,fin03,fout);
  261.     readln;
  262. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top