home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / CFIT1A.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-18  |  1.6 KB  |  91 lines
  1. program cfit1A;  { -> 142 }
  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. function random(dummy: integer): real;
  16. { random number 0-1 }
  17. { define seed=4.0 as global }
  18.  
  19. const pi = 3.14159;
  20.  
  21. var x : real;
  22.  i : integer;
  23.  
  24. begin { RANDOM }
  25.   x:=seed+pi;
  26.   x:=exp(5.0*ln(x));
  27.   seed:=x-trunc(x);
  28.   random:=seed
  29. end; { RANDOM }
  30.  
  31.  
  32.  
  33. procedure get_data(var x,y: ary;
  34.      var n: integer);
  35. { get values for n and arrays x,y }
  36. { y is randomly scattered about a straight line }
  37.  
  38. const a = 2.0;
  39.  b = 5.0;
  40.  
  41. var i,j : integer;
  42.  fudge : real;
  43.  
  44. begin
  45.   write('Fudge? ');
  46.   readln(fudge);
  47.   if fudge<0.0 then done:=true
  48.   else
  49.     begin
  50.       repeat
  51.  write('How many points? ');
  52.  readln(n)
  53.       until (n>2) and (n<=max);
  54.       if first then first:=false else clrscr;
  55.       for i:=1 to n do
  56.  begin
  57.    j:=n+1-i;
  58.    x[i]:=j;
  59.    y[i]:=(a+b*j)*(1.0+(2.0*random(0)-1.0)*fudge)
  60.       end { for-loop }
  61.     end  { if }
  62. end;  { procedure get_data }
  63.  
  64.  
  65. procedure write_data;
  66. { print out the answers }
  67. var i : integer;
  68.  
  69. begin
  70.   writeln;
  71.   writeln('    I      X     Y');
  72.   for i:=1 to n do
  73.     writeln(i:3,x[i]:8:1,y[i]:9:2);
  74.   writeln
  75. end;  { write_data }
  76.  
  77. begin { MAIN program }
  78.   clrscr;
  79.   seed:=4.0;
  80.   first:=true;
  81.   done:=false;
  82.   repeat
  83.     get_data(x,y,n);
  84.     if not done then
  85.       begin
  86.  write_data;
  87.  { ***** --->  more lines to be added here ********* }
  88.     end
  89.   until done
  90. end.
  91.