Advertisement
Guest User

Untitled

a guest
Nov 21st, 2019
103
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.27 KB | None | 0 0
  1. Program Project1;
  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. Arr: array of array of Integer;
  91. begin
  92. for i := 0 to n - 1 do
  93. for j := 0 to n - 1 do
  94. Read(MyFile, Matrixx[i, j]);
  95. CloseFile(MyFile);
  96. end;
  97.  
  98. function Average(Matrixx: MatrixType; n: Integer): TArr;
  99. var
  100. Sum, Amount, i, j: Integer;
  101. Arr: TArr;
  102. begin
  103. SetLength(Arr, n);
  104. Arr[i] := 0;
  105. for i := 0 to n - 1 do
  106. begin
  107. Sum := 0;
  108. Amount := 0;
  109. for j := 0 to n - 1 do
  110. if Matrixx[j, i] > 0 then
  111. begin
  112. Sum := Sum + Matrixx[j, i];
  113. Inc(Amount);
  114. end;
  115. Arr[i] := Sum / Amount;
  116. end;
  117. Average := Arr;
  118. end;
  119.  
  120. procedure MatrixOutput(const Matrixx: MatrixType; n: Integer);
  121. var
  122. i, j: Integer;
  123. begin
  124. for i := 0 to n do
  125. begin
  126. for j := 0 to n do
  127. write(Matrixx[i, j], ' ');
  128. Writeln;
  129. end;
  130. Writeln;
  131. end;
  132.  
  133. procedure AverageOutput(Arr: TArr; n: Integer);
  134. var
  135. i: Integer;
  136. begin
  137. for i := 0 to n - 1 do
  138. begin
  139. write(Arr[i], ' ');
  140. end;
  141. Writeln;
  142. end;
  143.  
  144. procedure WriteToFile(const Arr: TArr; n: Integer);
  145. var
  146. FName: string;
  147. NewFile: TextFile;
  148. i: Integer;
  149. begin
  150. AssignFile(NewFile, FName);
  151. rewrite(NewFile);
  152. for i := 0 to n - 1 do
  153. begin
  154. write(NewFile, Arr[i]);
  155. write(NewFile, ' ');
  156. end;
  157. CloseFile(NewFile);
  158. Writeln('Saved to file: ', FName);
  159. end;
  160.  
  161. var
  162. Matrixx: MatrixType;
  163. Size, i: Integer;
  164. Avrg: Real;
  165. MyTFile: TextFile;
  166. CorrectMatr: Boolean;
  167. Mass: TArr;
  168.  
  169. begin
  170. Writeln('This program finds the arithmetic mean of the positive elements of each column of the square matrix.');
  171. repeat
  172. ReadFileName(MyTFile);
  173. CorrectMatr := IsTheMatrixCorrect(MyTFile);
  174. if CorrectMatr = True then
  175. begin
  176. Writeln('Given matrix:');
  177. ReadMatrix(Matrixx, MyTFile, Size);
  178. Size := SizeOfMatrix(MyTFile);
  179. SetLength(Matrixx, Size, Size);
  180. MatrixOutput(Matrixx, Size);
  181. SetLength(Mass, Size);
  182. Mass := Average(Matrixx, Size);
  183. Writeln('The result after addition:');
  184. AverageOutput(Mass, Size);
  185. Writeln('Enter a file name to save:');
  186. WriteToFile(Mass, Size);
  187. end
  188. else
  189. CorrectMatr := False;
  190. Writeln('The name of the matrix inputs incorrect. Try again. Example: Name.txt');
  191. until CorrectMatr;
  192. Readln;
  193.  
  194. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement