MaksNew

Untitled

Oct 30th, 2020
175
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.12 KB | None | 0 0
  1. program Lab2_4;
  2.  
  3. uses
  4.     System.SysUtils;
  5.  
  6. type
  7.     Matrix = array of array of Integer;
  8.  
  9. var
  10.     MainMatrix: Matrix;
  11.     Order: Integer;
  12.     Path: String;
  13.     Count: Integer;
  14.     Zero: array of Integer;
  15.  
  16. function IsFileCorrect(var Path: String; Order: Integer): Boolean;
  17. var
  18.     ISize, JSize, Num: Integer;
  19.     IsCorrect: Boolean;
  20.     MatrixFile: TextFile;
  21. begin
  22.     ISize := 0;
  23.     JSize := 0;
  24.     IsCorrect := true;
  25.     AssignFile(MatrixFile, Path);
  26.     Reset(MatrixFile);
  27.     while not(SeekEof(MatrixFile)) and IsCorrect do
  28.     begin
  29.         inc(ISize);
  30.         while not(SeekEoln(MatrixFile)) and IsCorrect do
  31.         begin
  32.             try
  33.                 Read(MatrixFile, Num);
  34.             except
  35.                 IsCorrect := false;
  36.             end;
  37.             inc(JSize);
  38.         end;
  39.         Readln(MatrixFile);
  40.         if (JSize <> Order) then
  41.             IsCorrect := false;
  42.         JSize := 0;
  43.     end;
  44.     if ISize <> Order then
  45.         IsCorrect := false;
  46.     CloseFile(MatrixFile);
  47.     result := IsCorrect;
  48. end;
  49.  
  50. function FilePath(Order: Integer): String;
  51. var
  52.     Path: String;
  53.     IsCorrect: Boolean;
  54. begin
  55.     repeat
  56.         Writeln('Введите абсолютный путь к файлу ');
  57.         Readln(Path);
  58.         IsCorrect := false;
  59.         if FileExists(Path) then
  60.         begin
  61.             if IsFileCorrect(Path, Order) then
  62.                 IsCorrect := true
  63.             else
  64.                 Writeln('Данные в файле некорректны');
  65.         end
  66.         else
  67.             Writeln('Файл не найден');
  68.  
  69.     until IsCorrect;
  70.     result := Path;
  71. end;
  72.  
  73. function InputOrder(): Integer;
  74. var
  75.     Order: Integer;
  76.     IsCorrect: Boolean;
  77. begin
  78.     repeat
  79.         Writeln('Введите порядок матрицы: ');
  80.         IsCorrect := true;
  81.         try
  82.             Readln(Order)
  83.         except
  84.             IsCorrect := false;
  85.             Writeln('Порядок матрицы должен быть числом')
  86.         end;
  87.         if ((Order < 1) or (Order > 10000))and IsCorrect then
  88.         begin
  89.             Writeln('Размер матрицы должен принадлежать промежутку от 2 до 10000');
  90.             IsCorrect := false
  91.         end;
  92.  
  93.     until IsCorrect;
  94.     result := Order;
  95. end;
  96.  
  97. procedure FileToMatrix(var MainMatrix:Matrix; Order: Integer; var Path: String);
  98. var
  99.     I, J: Integer;
  100.     MatrixFile: TextFile;
  101. begin
  102.     SetLength(MainMatrix, Order, Order);
  103.     AssignFile(MatrixFile, Path);
  104.     Reset(MatrixFile);
  105.     for I := 0 to Order-1 do
  106.     begin
  107.         for J := 0 to Order-1 do
  108.         Read(MatrixFile, MainMatrix[I, J]);
  109.         Readln(MatrixFile);
  110.     end;
  111.     CloseFile(MatrixFile);
  112. end;
  113.  
  114. function Output(): String;
  115. var
  116.     Patho: String;
  117.     IsCorrect: Boolean;
  118. begin
  119.     IsCorrect := false;
  120.     repeat
  121.         Writeln('Введите директорию, в которую хотите сохранить матрицу');
  122.         Readln(Patho);
  123.         if DirectoryExists(Patho) then
  124.             IsCorrect := true
  125.         else
  126.             Writeln('Такой директории не существует.Попробуйте ещё раз');
  127.     until IsCorrect;
  128.     Result := Patho;
  129. end;
  130.  
  131. procedure ConditionToFile(Count: Integer);
  132. var
  133.     I, J: Integer;
  134.     OutputFile: TextFile;
  135.     Directory: String;
  136. begin
  137.     Directory := Output();
  138.     AssignFile(OutputFile, Directory + '\output.txt');
  139.     Rewrite(OutputFile);
  140.  
  141.     for I := 0 to High(MainMatrix) do
  142.     begin
  143.         for J := 0 to High(MainMatrix) do
  144.             Write(OutputFile, 'Количество столбцов матрицы, в которых имеются нулевые элементы: ' , count);
  145.             Writeln(OutputFile);
  146.     end;
  147.  
  148.     Writeln('Матрица сохранена по указанному пути');
  149.     CloseFile(OutputFile);
  150.     Write;
  151. end;
  152.  
  153. procedure PrintMatrix(MainMatrix: Matrix);
  154. var
  155.     I, J: Integer;
  156. begin
  157.     for I := 0 to High(MainMatrix) do
  158.     begin
  159.         for J := 0 to High(MainMatrix) do
  160.             Write(MainMatrix[I, J]:6);
  161.             Writeln;
  162.     end;
  163.     Writeln;
  164. end;
  165.  
  166. procedure PrintResult(Count: Integer);
  167. begin
  168.     Writeln('Количество столбцов матрицы, в которых имеются нулевые элементы: ', count);
  169. end;
  170.  
  171. function Condition(MainMatrix: Matrix; Order: Integer; Count:Integer): Integer;
  172. var
  173. I, J:Integer;
  174.  
  175. begin
  176.     for I := 0 to Order do
  177.     begin
  178.     J := 0;
  179.         while J < Order do
  180.         begin
  181.             if MainMatrix[J][I] = 0 then
  182.             begin
  183.             Inc(Count);
  184.             J := 3;
  185.             end;
  186.         Inc(J);
  187.     end;
  188.     end;
  189.     PrintResult(Count);
  190.     Result := Count;
  191. end;
  192.  
  193. begin
  194.     Order := InputOrder();
  195.     Path := FilePath(Order);
  196.     FileToMatrix(MainMatrix, Order, Path);
  197.     Writeln('Матрица, для которой производились вычисления: ');
  198.     PrintMatrix(MainMatrix);
  199.     Count := Condition(MainMatrix, Order, Count);
  200.     ConditionToFile(Count);
  201.     Readln;
  202.  
  203. end.
Advertisement
Add Comment
Please, Sign In to add comment