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