home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / CFIT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-18  |  1.3 KB  |  76 lines

  1. program cfit1;  { -> 139 }
  2. { Pascal program to perform a linear least-squares fit }
  3.  
  4. const max = 20;
  5.  
  6. type index = 1..max;
  7.  ary = array[index] of real;
  8.  
  9. var x,y,y_calc : ary;
  10.  n  : integer;
  11.  first,done : boolean;
  12.  seed,a,b : real;
  13.  
  14.  
  15. {$I RANDOM.LIB }
  16.  
  17. procedure get_data(var x,y: ary;
  18.      var n: integer);
  19. { get values for n and arrays x,y }
  20. { y is randomly scattered about a straight line }
  21.  
  22. const a = 2.0;
  23.  b = 5.0;
  24.  
  25. var i,j : integer;
  26.  fudge : real;
  27.  
  28. begin
  29.   write('Fudge? ');
  30.   readln(fudge);
  31.   if fudge<0.0 then done:=true
  32.   else
  33.     begin
  34.       repeat
  35.  write('How many points? ');
  36.  readln(n)
  37.       until (n>2) and (n<=max);
  38.       if first then first:=false else clrscr;
  39.  
  40.       for i:=1 to n do
  41.  begin
  42.    j:=n+1-i;
  43.    x[i]:=j;
  44.    y[i]:=(a+b*j)*(1.0+(2.0*random(0)-1.0)*fudge)
  45.       end { for-loop }
  46.     end  { if }
  47. end;  { procedure get_data }
  48.  
  49.  
  50. procedure write_data;
  51. { print out the answers }
  52. var i : integer;
  53.  
  54. begin
  55.   writeln;
  56.   writeln('      I      X     Y');
  57.   for i:=1 to n do
  58.     writeln(i:3,x[i]:8:1,y[i]:9:2);
  59.   writeln
  60. end;  { write_data }
  61.  
  62. begin { MAIN program }
  63.   first:=true;
  64.   seed:=4.0;
  65.   clrscr;
  66.   done:=false;
  67.   repeat
  68.     get_data(x,y,n);
  69.     if not done then
  70.       begin
  71.  write_data;
  72.  { ***** --->  more lines to be added here ********* }
  73.     end
  74.   until done
  75. end.
  76.