home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / turbopas / pas_sci.arc / CFIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-27  |  1KB  |  73 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. procedure get_data(var x,y: ary;
  15.            var n: integer);
  16. { get values for n and arrays x,y }
  17. { y is randomly scattered about a straight line }
  18.  
  19. const    a = 2.0;
  20.     b = 5.0;
  21.  
  22. var    i,j    : integer;
  23.     fudge    : real;
  24.  
  25. begin
  26.   write('Fudge? (<0 to terminate)');
  27.   readln(fudge);
  28.   if fudge<0.0 then done:=true
  29.   else
  30.     begin
  31.       repeat
  32.     write('How many points? ');
  33.     readln(n)
  34.       until (n>2) and (n<=max);
  35.       if first then first:=false else ClrScr;
  36.  
  37.       for i:=1 to n do
  38.     begin
  39.       j:=n+1-i;
  40.       x[i]:=j;
  41.       y[i]:=(a+b*j)*(1.0+(2.0*Random-1.0)*fudge)
  42.       end    { for-loop }
  43.     end        { if }
  44. end;        { procedure get_data }
  45.  
  46.  
  47. procedure write_data;
  48. { print out the answers }
  49. var    i    : integer;
  50.  
  51. begin
  52.   writeln;
  53.   writeln('      I      X     Y');
  54.   for i:=1 to n do
  55.     writeln(i:3,x[i]:8:1,y[i]:9:2);
  56.   writeln
  57. end;        { write_data }
  58.  
  59. begin    { MAIN program }
  60.   first:=true;
  61.   seed:=4.0;
  62.   ClrScr;
  63.   done:=false;
  64.   repeat
  65.     get_data(x,y,n);
  66.     if not done then
  67.       begin
  68.     write_data;
  69.     { ***** --->  more lines to be added here ********* }
  70.     end
  71.   until done
  72. end.
  73.