thoga31

Students (school exercise)

Sep 26th, 2013
103
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 2.88 KB | None | 0 0
  1. (* Mistake: I have uploaded this code as a guest, because of whatever reason the browser forgot my credentials, so I was not logged on... stupid thing. *)
  2.  
  3. {$mode objfpc}
  4. program students;
  5. uses sysutils, strutils;
  6.  
  7. const DIM = 20;
  8.       FNAME = 'teste';
  9.       TAB = '    ';
  10.  
  11. type TArrayInt = array of smallint;
  12.      TFileInt = file of smallint;
  13.  
  14. var grades, negative_grades : TArrayInt;
  15.     n : smallint;
  16.     GradeFile : TFileInt;
  17.  
  18. procedure FillArray(var arr : TArrayInt; dimension : longint; const prompt : string);
  19. begin
  20.     setlength(arr, dimension-1);
  21.     for dimension := low(arr) to high(arr) do begin
  22.         write(AnsiReplaceText(prompt, '@{COUNT}', IntToStr(dimension)));
  23.         readln(arr[dimension]);
  24.     end;
  25. end;
  26.  
  27. procedure CopyArrayToFile(const arr : TArrayInt; out f : TFileInt);
  28. var elem : smallint;
  29. begin
  30.     for elem in arr do
  31.         write(f, elem);
  32. end;
  33.  
  34. procedure GetArrayFromFile(var f : TFileInt; out arr : TArrayInt);
  35. var i : smallint = 0;
  36. begin
  37.     seek(f,0);
  38.     SetLength(arr, FileSize(f));
  39.     while not eof(f) do begin
  40.         read(f, arr[i]);
  41.         inc(i);
  42.     end;
  43. end;
  44.  
  45. function CountPositive(arr : TArrayInt; const minimum : smallint = 0) : smallint;
  46. var elem : smallint;
  47. begin
  48.     CountPositive := 0;
  49.     for elem in arr do
  50.         if elem >= minimum then
  51.             inc(CountPositive);
  52. end;
  53.  
  54. function CountPositive(var f : TFileInt; const minimum : smallint = 0) : smallint; overload;
  55. var arr : TArrayInt;
  56. begin
  57.     GetArrayFromFile(f, arr);
  58.     CountPositive := CountPositive(arr, minimum);
  59. end;
  60.  
  61. procedure GetNegative(arr : TArrayInt; out neg : TArrayInt; const minimum : smallint = 0);
  62. var elem : smallint;
  63. begin
  64.     for elem in arr do
  65.         if elem < minimum then begin
  66.             SetLength(neg, length(neg)+1);
  67.             neg[length(neg)-1] := elem;
  68.         end;
  69. end;
  70.  
  71. procedure GetNegative(var f : TFileInt; out neg : TArrayInt; const minimum : smallint = 0); overload;
  72. var arr : TArrayInt;
  73. begin
  74.     GetArrayFromFile(f, arr);
  75.     GetNegative(arr, neg, minimum);
  76. end;
  77.  
  78. function Average(arr : TArrayInt) : real;
  79. var elem : smallint;
  80. begin
  81.     Average := 0.0;
  82.     for elem in arr do
  83.         Average := Average + elem;
  84.     Average := Average / length(arr);
  85. end;
  86.  
  87. function Average(var f : TFileInt) : real;
  88. var arr : TArrayInt;
  89. begin
  90.     GetArrayFromFile(f, arr);
  91.     Average := Average(arr);
  92. end;
  93.  
  94. begin
  95.     assign(GradeFile, FNAME);
  96.     FillArray(grades, 5, 'Write the @{COUNT} grade: ');
  97.     rewrite(GradeFile);
  98.     CopyArrayToFile(grades, GradeFile);
  99.     close(GradeFile);
  100.     reset(GradeFile);
  101.     writeln('There is/are ', CountPositive(GradeFile), ' positive grades.');
  102.     GetNegative(GradeFile, negative_grades, 10);
  103.     writeln('Negative grades:');
  104.     for n in negative_grades do
  105.         writeln(TAB, n);
  106.     writeln('Average = ', Average(GradeFile));
  107.     close(GradeFile);
  108.     readln;
  109. end.
Advertisement
Add Comment
Please, Sign In to add comment