SHARE
TWEET

lab11 only procedure

bogdanpashtet Dec 14th, 2019 (edited) 95 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program lab11;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils,
  7.   Windows;
  8.  
  9. const n_max=10;
  10.  
  11. type
  12.   matrix=array[1..n_max,1..n_max] of integer;
  13.   mass=array[1..n_max] of integer;
  14.  
  15. procedure rus; {русификация}
  16.     begin
  17.         SetConsoleCP(1251);
  18.         SetConsoleOutputCP(1251);
  19.     end;
  20.  
  21. procedure check_files(var dat1,dat2,dat3,rez:textfile); {проверка входных файлов}
  22.   begin
  23.     if (paramcount = 0) then
  24.       begin
  25.         writeln ('К ярлыку не привязаны файлы.');
  26.         writeln('...');
  27.         readln;
  28.         halt
  29.       end;
  30.       assignfile(dat1,paramstr(1));
  31.       assignfile(dat2,paramstr(2));
  32.       assignfile(dat3,paramstr(3));
  33.       assignfile(rez,paramstr(4));
  34.  
  35.     try
  36.       Reset(dat1);
  37.     except
  38.       writeln('Ошибка при окрытии входного файла №1.');
  39.       writeln('...');
  40.       readln;
  41.       halt
  42.       end;
  43.  
  44.     try
  45.       Reset(dat2);
  46.     except
  47.       writeln('Ошибка при окрытии входного файла №2.');
  48.       close(dat1);
  49.       writeln('...');
  50.       readln;
  51.       halt
  52.       end;
  53.  
  54.     try
  55.       Reset(dat3);
  56.     except
  57.       writeln('Ошибка при окрытии входного файла №3.');
  58.       close(dat1);
  59.       close(dat2);
  60.       writeln('...');
  61.       readln;
  62.       halt
  63.       end;    
  64.  
  65.     try
  66.       Rewrite(rez);
  67.     except
  68.       writeln('Ошибка при создании или открытии выходного файла.');
  69.       close(dat1);
  70.       close(dat2);
  71.       close(dat3);
  72.       writeln('...');
  73.       readln;
  74.       halt
  75.       end;
  76.   end;
  77.  
  78. procedure close_pr(var dat1,dat2,dat3,rez:textfile); {выход из программы}
  79.     begin
  80.         close(dat1);
  81.         close(dat2);
  82.         close(dat3);
  83.         close(rez);
  84.         writeln('...');
  85.         readln;
  86.         halt
  87.     end;
  88.  
  89. procedure check_n(var dat1:textfile; matrix_name:string; var n1:integer; out flag_n1:boolean); {ввод и проверка N на читабельность и диапазон}
  90.     begin
  91.         try
  92.             read(dat1, n1);
  93.         except
  94.             writeln('Ошибка при чтении размерности матрицы ',matrix_name,'.');
  95.             flag_n1:=false;
  96.             end;
  97.         flag_n1:=true;
  98.         if ((n1<1) or (n1>n_max)) and (flag_n1=true) then
  99.             begin
  100.                 writeln('Размерность матрицы ',matrix_name,' выходит за диапазон условленных значений.');
  101.                 flag_n1:=false;
  102.             end;
  103.     end;
  104.  
  105. procedure check_mass(var dat1:textfile; matrix_name:string; var a:matrix; var n1:integer; out flag_a:boolean); {ввод массива и проверка его элементов}
  106.   var
  107.     i,j:integer;
  108.   begin
  109.     i:=0;
  110.     flag_a:=false;
  111.     while (i<n1) and (flag_a=false) do
  112.       begin
  113.         inc(i);
  114.         j:=0;
  115.         while (j<n1) and (flag_a=false) do
  116.           begin
  117.             inc(j);
  118.             try
  119.               read(dat1, a[i,j]);
  120.             except
  121.               writeln('Ошибка при чтении',matrix_name,'[',i,';',j,'].');
  122.               flag_a:=true
  123.               end;
  124.             if (abs(a[i,j])>10)and (flag_a=false) then
  125.               begin
  126.                 writeln(matrix_name,'[',i,';',j,'] выходит за диапазон условленных значений.');
  127.                 flag_a:=true
  128.               end;
  129.           end;
  130.         readln(dat1);
  131.       end;
  132.   end;
  133.  
  134. procedure quest(const a:matrix; var n1:integer; out d:mass; out inv1:integer); {подсчет инверсий и форммирование массива}
  135.   var
  136.     i,j,count:integer;
  137.   begin
  138.     inv1:=0;
  139.     for i:=1 to n1 do
  140.       begin
  141.         count:=0;
  142.         for j:=1 to n1-1 do
  143.           begin
  144.             if (a[i,j]>a[i,j+1]) then
  145.               inc(count);
  146.           end;
  147.         if count>2 then
  148.           d[i]:=1
  149.         else
  150.           d[i]:=0;
  151.         inv1:=inv1+count;
  152.       end;
  153.   end;
  154.  
  155. procedure output_matrix(var rez:textfile; matrix_name:string; const a:matrix; var n1:integer); {вывод матрицы}
  156.   var
  157.    i,j:integer;
  158.   begin
  159.     writeln(rez,'Матрица ',matrix_name,' из',n1:2,' строк и',n1:2,' столбцов:');
  160.     writeln(rez);
  161.     for i:=1 to n1 do
  162.       begin
  163.         for j:=1 to n1 do
  164.           begin
  165.             write(rez, a[i,j]:5,' ');
  166.           end;
  167.         writeln(rez);
  168.       end;
  169.     writeln(rez);
  170.   end;
  171.  
  172. procedure output_mass(var rez:textfile; mass_name:string; const d:mass; var n1:integer); {вывод массива}
  173.   var
  174.     i:integer;
  175.   begin
  176.     writeln(rez);
  177.     writeln(rez,'Массив ',mass_name,': ');
  178.     for i:=1 to n1 do
  179.       begin
  180.         write(rez,d[i],' ');
  181.       end;
  182.     writeln(rez);
  183.   end;
  184.  
  185. procedure search_max(var rez: textfile; var inv1,inv2,inv3:integer); {поиск максимального количества инверсий}
  186.   begin
  187.     if (inv1=0) and (inv2=0) and (inv3=0) then
  188.       begin
  189.         writeln(rez);
  190.         writeln(rez,'Ни в одной из матриц нет инверсий.')
  191.       end
  192.     else
  193.       begin
  194.         writeln(rez);
  195.         writeln(rez,'Общее количество инверсий матрицы A: ', inv1);
  196.         writeln(rez);
  197.  
  198.         writeln(rez);
  199.         writeln(rez,'Общее количество инверсий матрицы B: ', inv2);
  200.         writeln(rez);
  201.  
  202.         writeln(rez);
  203.         writeln(rez,'Общее количество инверсий матрицы C: ', inv3);
  204.         writeln(rez);
  205.  
  206.         if inv1>inv2 then
  207.           begin
  208.             if inv1>inv3 then
  209.               writeln(rez,'В матрице A самое большое количество инверсий.')
  210.             else
  211.               writeln(rez,'В матрице C самое большое количество инверсий.');
  212.           end
  213.         else
  214.           begin
  215.             if inv2>inv3 then
  216.               writeln(rez,'В матрице B самое большое количество инверсий.')
  217.             else
  218.               writeln(rez,'В матрице C самое большое количество инверсий.');
  219.           end;
  220.  
  221.  
  222.       end;
  223.   end;
  224.  
  225.  
  226. var
  227.   n1,n2,n3,inv1,inv2,inv3:integer;
  228.   a,b,c:matrix;
  229.   d,e,f:mass;
  230.   dat1,dat2,dat3,rez:textfile;
  231.   a_name,b_name,c_name,d_mass,e_mass,f_mass:string;
  232.   flag_n1,flag_n2,flag_n3,flag_a,flag_b,flag_c:boolean;
  233.  
  234. begin
  235.   a_name:='A';
  236.   b_name:='B';
  237.   c_name:='C';
  238.   d_mass:='D';
  239.   e_mass:='E';
  240.   f_mass:='F';
  241.  
  242.   rus;
  243.   check_files(dat1,dat2,dat3,rez);
  244.  
  245.   check_n(dat1,a_name,n1,flag_n1);
  246.   if (flag_n1=false) then
  247.     close_pr(dat1,dat2,dat3,rez);
  248.   check_n(dat2,b_name,n2,flag_n2);
  249.   if (flag_n2=false) then
  250.     close_pr(dat1,dat2,dat3,rez);
  251.   check_n(dat3,c_name,n3,flag_n3);
  252.   if (flag_n3=false) then
  253.     close_pr(dat1,dat2,dat3,rez);
  254.  
  255.  
  256.   check_mass(dat1,a_name,a,n1,flag_a);
  257.   if (flag_a=true) then
  258.     close_pr(dat1,dat2,dat3,rez);
  259.   check_mass(dat2,b_name,b,n2,flag_b);
  260.   if (flag_b=true) then
  261.     close_pr(dat1,dat2,dat3,rez);
  262.   check_mass(dat3,c_name,c,n3,flag_c);
  263.   if (flag_c=true)  then
  264.     close_pr(dat1,dat2,dat3,rez);
  265.  
  266.   closefile(dat1);
  267.   closefile(dat2);
  268.   closefile(dat3);
  269.  
  270.   quest(a,n1,d,inv1);
  271.   quest(b,n2,e,inv2);
  272.   quest(c,n3,f,inv3);
  273.  
  274.   writeln(rez,'Лабораторная работа №11.');
  275.   writeln(rez);
  276.   output_matrix(rez,a_name,a,n1);
  277.   output_matrix(rez,b_name,b,n2);
  278.   output_matrix(rez,c_name,c,n3);
  279.   writeln(rez,'___________________________________________________________________________');
  280.   output_mass(rez,d_mass,d,n1);
  281.   output_mass(rez,e_mass,e,n2);
  282.   output_mass(rez,f_mass,f,n3);
  283.  
  284.   search_max(rez,inv1,inv2,inv3);
  285.  
  286.   closefile(rez);
  287.   readln;
  288. 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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top