home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DISK_425.ZIP / CFIT1A.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-03  |  1.6 KB  |  92 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. external procedure cls;
  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 cls;
  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. begin    { MAIN program }
  79.   cls;
  80.   seed:=4.0;
  81.   first:=true;
  82.   done:=false;
  83.   repeat
  84.     get_data(x,y,n);
  85.     if not done then
  86.       begin
  87.     write_data;
  88.     { ***** --->  more lines to be added here ********* }
  89.     end
  90.   until done
  91. end.
  92.