home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol071 / statpack.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.1 KB  |  108 lines
  1. program ogorman;
  2. {$c-,m-,f-}
  3. type 
  4. byte = 0..255;
  5.  
  6. var
  7. statistics:array[1..1000] of real;
  8. xx,number:integer;
  9. stop:char;
  10.  
  11. procedure clear_screen;
  12. begin
  13. write(chr(27),'[2J',chr(27),'[1;1H');
  14. end;
  15.  
  16. procedure stat_average;
  17. var
  18. standard_deviation,max,min,average,sum:real;
  19. counter:integer;
  20. ii,i:byte;
  21. ch:char;
  22.  
  23.  
  24. procedure calc_variance;
  25. var
  26. i:byte;
  27. variance,xvariance:real;
  28.  
  29. begin
  30. xvariance:=0.0;
  31. for i:= 1 to 1000 do
  32. if statistics[i] <> -1.0 then
  33.     xvariance:=xvariance + sqr(statistics[i]-average);
  34. variance:=xvariance/(counter-1);
  35. standard_deviation:= sqrt(variance);
  36. end;
  37.  
  38. begin
  39. clear_screen;
  40. writeln('STATISTICAL ANALYSIS FOR TEST ');
  41. writeln;
  42. writeln;
  43.  
  44. sum:= 0.0;
  45. counter:= 0;
  46.  
  47. max:= statistics[1];                {init max,min to first value}
  48. if statistics[1] = -1.0 then
  49.     min:= -1.0 else min:= statistics[1];
  50.  
  51. for ii:= 1 to 1000 do
  52. begin
  53.     if statistics[ii] <> -1.0 then 
  54.         begin
  55.         sum:= sum + statistics[ii];
  56.         counter:= counter + 1;
  57.         if statistics[ii] > max then
  58.           max:= statistics[ii];
  59.          if statistics[ii] < min then
  60.         min:= statistics[ii];
  61.         end;
  62. end;
  63. average:= sum/counter;
  64. if (average = 0.0) or (average = -1.0) then
  65.     write('no average calculated ':18) else
  66.         begin
  67.         calc_variance;
  68.         write('  average: ',average:7:1);
  69.         write('  n = ',counter:4,'  S.D.= ',standard_deviation:7:1);
  70.         end;
  71.  
  72. if max <> -1.0 then write('  max = ',max:7:1) else
  73.               write('  no max ':7);
  74. if min <> -1.0 then write('  min = ',min:7:1) else
  75.                   write('  no min ':7);
  76. writeln;
  77.  
  78. end;
  79.  
  80.  
  81. begin    {MAIN PROGRAM}
  82.  
  83.  
  84. repeat
  85. clear_screen;
  86. for xx:= 1 to 1000 do statistics[xx]:=-1.0;  {initialize array}
  87.  
  88. writeln('At prompt, enter value. Enter a value of -1 to stop entering data ');
  89.  
  90. xx:=0;
  91.  
  92. repeat
  93. xx:=xx+1;
  94.  
  95. repeat
  96. write(xx:2,' --->  ');
  97. read(statistics[xx]);
  98. until (statistics[xx] < 1000.0) and (statistics[xx] > -1.1);{check limits}
  99.  
  100. until statistics[xx] = -1.0;  {input values until = -1 ie done}
  101.  
  102. stat_average;
  103.  
  104. writeln;
  105. write('Do you have additional data to analyze?  y/n  ');
  106. read (stop)
  107. until (stop = 'n') or (stop = 'N');
  108. end.