klasscho

Untitled

Nov 23rd, 2019
167
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.28 KB | None | 0 0
  1. Program Project9;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6. SysUtils;
  7.  
  8. type
  9. MatrixType = array of array of Integer;
  10. TArr = array of Real;
  11.  
  12. function SizeOfMatrix(var MyFile: TextFile): Integer;
  13. var
  14. Numb, n, NumbEx, Temp: Integer;
  15. IsCorrect, FirstIt: Boolean;
  16. begin
  17. n := 0;
  18. FirstIt := True;
  19. IsCorrect := True;
  20. while (not Eof(MyFile)) and IsCorrect do
  21. begin
  22. NumbEx := Numb;
  23. Numb := 0;
  24. while not Eoln(MyFile) do
  25. begin
  26. Inc(Numb);
  27. Read(MyFile, Temp);
  28. end;
  29. if NumbEx <> Numb then
  30. IsCorrect := False;
  31. if FirstIt then
  32. begin
  33. IsCorrect := True;
  34. FirstIt := False;
  35. end;
  36. Inc(n);
  37. Readln(MyFile);
  38. end;
  39. if (Numb = n) and IsCorrect then
  40. SizeOfMatrix := n
  41. else
  42. SizeOfMatrix := 0;
  43. Reset(MyFile);
  44. end;
  45.  
  46. procedure ReadFileName(var MyFile: TextFile);
  47. var
  48. FName: string;
  49. CorrectName: Boolean;
  50. begin
  51. Writeln('Enter a file name for data entry in the format Name.txt');
  52. repeat
  53. Readln(FName);
  54. if FileExists(FName) then
  55. CorrectName := True
  56. else
  57. begin
  58. Writeln('The file name was entered incorrectly. Try again. Example: Name.txt');
  59. CorrectName := False;
  60. end;
  61. until CorrectName;
  62. AssignFile(MyFile, FName);
  63. Reset(MyFile);
  64. end;
  65.  
  66. function IsTheMatrixCorrect(var MyFile: TextFile): Boolean;
  67. var
  68. Number: Integer;
  69. TrueMatrix, IsValidInput: Boolean;
  70. begin
  71. TrueMatrix := True;
  72. while (not Eof(MyFile)) do
  73. begin
  74. try
  75. read(MyFile, Number)
  76. except
  77. TrueMatrix := False
  78. end;
  79. end;
  80. if Eof(MyFile) then
  81. IsValidInput := True
  82. else
  83. Writeln('File is empty.');
  84. Reset(MyFile);
  85. IsTheMatrixCorrect := TrueMatrix;
  86. end;
  87.  
  88. procedure ReadMatrix(var Matrixx: MatrixType; var MyFile: TextFile; n: Integer);
  89. var
  90. i, j: Integer;
  91. FName: string;
  92. begin
  93. for i := 0 to n - 1 do
  94. for j := 0 to n - 1 do
  95. Read(MyFile, Matrixx[i, j]);
  96. Reset(MyFile);
  97. end;
  98.  
  99. procedure Average(const Matrixx: MatrixType; n: Integer; var Arr: TArr);
  100. var
  101. Sum, Amount, i, j: Integer;
  102. begin
  103. for i := 0 to n - 1 do
  104. begin
  105. Sum := 0;
  106. Amount := 0;
  107. for j := 0 to n - 1 do
  108. if Matrixx[j, i] > 0 then
  109. begin
  110. Sum := Sum + Matrixx[j, i];
  111. Inc(Amount);
  112. end;
  113. Arr[i] := Sum / Amount;
  114. end;
  115. end;
  116.  
  117. procedure MatrixOutput(const Matrixx: MatrixType; n: Integer);
  118. var
  119. i, j: Integer;
  120. begin
  121. for i := 0 to n - 1 do
  122. begin
  123. for j := 0 to n - 1 do
  124. write(Matrixx[i, j], ' ');
  125. Writeln;
  126. end;
  127. Writeln;
  128. end;
  129.  
  130. procedure AverageOutput(const Arr: TArr; n: Integer);
  131. var
  132. i: Integer;
  133. begin
  134. for i := 0 to n - 1 do
  135. begin
  136. write(Arr[i], ' ');
  137. end;
  138. Writeln;
  139. end;
  140.  
  141. procedure WriteToFile(const Arr: TArr; n: Integer; FName: string );
  142. var
  143. NewFile: TextFile;
  144. i: Integer;
  145. begin
  146. AssignFile(NewFile, FName);
  147. rewrite(NewFile);
  148. for i := 0 to n - 1 do
  149. begin
  150. write(NewFile, Arr[i]);
  151. write(NewFile, ' ');
  152. end;
  153. CloseFile(NewFile);
  154. Writeln('Saved to file: ', FName);
  155. end;
  156.  
  157. var
  158. Matrixx: MatrixType;
  159. Size: Integer;
  160. MyTFile: TextFile;
  161. MyTFileName: string;
  162. CorrectMatr: Boolean;
  163. Mass: TArr;
  164.  
  165. begin
  166. Writeln('This program finds the arithmetic mean of the positive elements of each column of the square matrix.');
  167. repeat
  168. ReadFileName(MyTFile);
  169. CorrectMatr := IsTheMatrixCorrect(MyTFile);
  170. if CorrectMatr = True then
  171. begin
  172. Writeln('Given matrix:');
  173. Size := SizeOfMatrix(MyTFile);
  174. SetLength(Matrixx, Size, Size);
  175. ReadMatrix(Matrixx, MyTFile, Size);
  176. CloseFile(MyTFile);
  177. MatrixOutput(Matrixx, Size);
  178. SetLength(Mass, Size);
  179. Average(Matrixx, Size, Mass);
  180. Writeln('The result after addition:');
  181. AverageOutput(Mass, Size);
  182. Writeln('Enter a file name to save:');
  183. WriteToFile(Mass, Size, MyTFileName);
  184. end
  185. else
  186. begin
  187. CorrectMatr := False;
  188. Writeln('The name of the matrix inputs incorrect. Try again. Example: Name.txt');
  189. end;
  190. until CorrectMatr;
  191. Readln;
  192. end.
Advertisement
Add Comment
Please, Sign In to add comment