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