klasscho

Untitled

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