Pohuyumer

Lab 12 unit

Jan 24th, 2020
88
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit Unit12;
  2.  
  3. interface
  4.  
  5.   const n_max=5;
  6.  
  7.   type matrix=array[1..n_max,1..n_max] of shortint;
  8.  
  9.                       {Проверка подключенных файлов}
  10.   procedure check_files(var dat,rez:textfile);
  11.  
  12.                        {Проверка размерности матрицы}
  13.   procedure check_n(var dat:textfile; out n:shortint; out flag_n:boolean);
  14.  
  15.                    {Ввод матрицы из файла, файл уже открыт}
  16.   procedure input(var a:matrix; const n:integer; var dat:textfile; out p,e:shortint);
  17.  
  18.                     {Ввод и проверка элементов матрицы}
  19.   procedure check_a(var dat:textfile; const n:shortint; out a:matrix; out flag_a:boolean);
  20.  
  21.             {Проверка на наличие элемента, удовлетворяещего условию |a[i,j]|-|P|<E}
  22.   function analysis(const a:matrix; const n,p,e:shortint; out m:shortint):boolean;
  23.  
  24.                  {Поиск среднего арифметического положительных элементов}
  25.   procedure check_average_positive(var rez:textfile; var a:matrix; const n:shortint; out av:real);
  26.  
  27.                 {Вывод матрицы и переменных в файл, файл уже открыт}
  28.   procedure output_a(const a:matrix; const n,p,e:shortint; out rez:textfile);
  29.  
  30.                   {Закрытие файлов}
  31.   procedure close_pr(var dat,rez:textfile);
  32.  
  33.  
  34. implementation
  35.  
  36.   procedure check_files; //проверка входного и выходного файла
  37.       begin
  38.       if (paramcount = 0) then
  39.       begin
  40.         writeln ('К ярлыку не привязаны файлы.');
  41.         writeln('...');
  42.         readln;
  43.         halt
  44.       end;
  45.       assignfile(dat,paramstr(1));
  46.       assignfile(rez,paramstr(2));
  47.  
  48.     try //try-except
  49.       Reset(dat);
  50.     except
  51.       writeln('Ошибка при окрытии входного файла.');
  52.       writeln('...');
  53.       readln;
  54.       halt
  55.       end;
  56.  
  57.     try
  58.       Rewrite(rez);
  59.     except
  60.       writeln('Ошибка при создании или открытии выходного файла.');
  61.       close(dat);
  62.       writeln('...');
  63.       readln;
  64.       halt
  65.       end;
  66.     end;
  67.  
  68.   procedure check_n; //проверка размерности матрицы
  69.     begin
  70.        flag_n:=true;
  71.        try
  72.          read(dat,n);
  73.        except
  74.          writeln('Ошибка при чтении размерности матрицы A.');
  75.          flag_n:=false;
  76.        end;
  77.        if ((n<1) or (n>n_max)) and (flag_n=true) then
  78.           begin
  79.              writeln('Размерность матрицы A выходит за диапазон условленных значений.');
  80.              flag_n:=false;
  81.           end;
  82.        writeln('N = ',flag_n,' after check_n');
  83.     end;
  84.  
  85.   procedure input;
  86.   var
  87.      i,j:shortint;
  88.   begin
  89.      readln(dat,P);
  90.      readln(dat,E);
  91.      for i := 1 to n do
  92.          begin
  93.             for j := 1 to n do
  94.                 begin
  95.                    read(dat,a[i,j]);
  96.                 end;
  97.          end;
  98.  
  99.   end;
  100.  
  101.   procedure check_a; //ввод и проверка элементов матрицы
  102.     var
  103.       i,j:byte;
  104.     begin
  105.        i:=0;
  106.        flag_a:=true;
  107.        while (i<n) and (flag_a=true) do
  108.              begin
  109.                 inc(i);
  110.                 j:=0;
  111.                 while (j<n) and (flag_a=true) do
  112.                       begin
  113.                          inc(j);
  114.                          if (abs(a[i,j])>100) and (flag_a=true) then
  115.                             begin
  116.                                writeln('A[',i,';',j,'] выходит за диапазон условленных значений.');
  117.                                flag_a:=false;
  118.                             end;
  119.                       end;
  120.              end;
  121.     writeln('A = ',flag_a,' after check_a');
  122.     end;
  123.  
  124.   function analysis(const a:matrix; const n,p,e:shortint; out m:shortint):boolean; //проверка на наличие
  125.     var
  126.       i,j:byte;
  127.       flag:boolean;
  128.     begin
  129.        flag:=true;
  130.        for i := 1 to n do
  131.            begin
  132.               for j := 1 to n do
  133.                   begin
  134.                      if ((abs(abs(a[i,j])-abs(P)))<E) then
  135.                         begin
  136.                            flag:=false;
  137.                            m:=a[i,j];
  138.                         end;
  139.                   end
  140.            end;
  141.        analysis:=flag;
  142.     end;
  143.  
  144.   procedure check_average_positive; //поиск среднего арифметического положительных элементов каждой строки
  145.     var
  146.       i,j:byte;
  147.       sum:shortint;
  148.     begin
  149.        sum:=0;
  150.        for i := 1 to n do
  151.            begin
  152.               for j := 1 to n do
  153.                   begin
  154.                      if (a[i,j])>0 then
  155.                         sum:=sum+a[i,j];
  156.                   end;
  157.               av:=sum/n;
  158.               writeln(rez, 'Среднее арифметическое положительных элементов ',i,' строки', ' = ',av:4:3,'  ');
  159.               sum:=0;
  160.            end;
  161.     end;
  162.  
  163.   procedure output_a; //вывод матрицы
  164.     var
  165.        i,j:byte;
  166.     begin
  167.        writeln(rez,'-----------------');
  168.        for i:=1 to n do
  169.            begin
  170.               for j:=1 to n do
  171.                   write(rez,a[i,j],' ');
  172.                   writeln(rez);
  173.            end;
  174.        writeln(rez,'-----------------');
  175.        writeln(rez,'P = ',P);
  176.        writeln(rez,'E = ',E);
  177.        writeln(rez,'-----------------');
  178.     end;
  179.  
  180. procedure close_pr; //выход из программы
  181.     begin
  182.         close(dat);
  183.         close(rez);
  184.         writeln('...');
  185.         readln;
  186.         halt
  187.     end;
  188. end.
RAW Paste Data