type
 TPolynom          = record   { Polynom P(x)=c0+c1*t+c2*t^2+...  }
  Power            : Integer; { Polynom power, 0..9              }
  Scale            : Real;    { Polynom scale factor             }
  Center           : Real;    { Polynom center point             }
  Coeff            : array[0..9] of Real; { Polynom coefficients }
 end;                         { P(x)=p(t), t=(x-Center)/Scale    }
{
Find least squares polynom P(x)=p(t)=c[0]+c[1]*t+c[2]*t^2...
where t=(x-Center)/Scale by given curve crv
}
function PolynomFind(var Poly:TPolynom; crv,Power:Integer;Center,Scale,Eps:Real):Boolean;
type
 TVector=array[0..9] of Real;
 TMatrix=array[0..9] of TVector;
 var A:TMatrix; P,Q:TVector; i:Integer;
 function Solve(N:Integer; var A:TMatrix; var X,Y:TVector; Eps:Real):Integer;
 var i,j,k,p,err:Integer; S:Real;
 begin
  err:=0;
  if (N<1) or (N>10) then err:=err+1 else
  if N=1 then begin
   if abs(A[0,0])<=Eps then err:=err+1 else X[0]:=Y[0]/A[0,0];
  end else
  for j:=0 to N-2 do begin
   p:=j;
   for i:=j+1 to N-1 do if ABS(A[i,j])>ABS(A[p,j]) then p:=i;
   if p <> j then begin
    for k:=0 to N-1 do begin
     S:=A[p,k];
     A[p,k]:=A[j,k];
     A[j,k]:=S;
    end;
    S:=Y[p];
    Y[p]:=Y[j];
    Y[j]:=S;
   end;
   S:=A[j,j];
   if abs(S)<=Eps then err:=err+1;
   for i:=j+1 to N-1 do begin
    S:=-A[i,j]/A[j,j];
    for k:=0 to N-1 do A[i,k]:=A[i,k]+S*A[j,k];
    Y[i]:=Y[i]+S*Y[j];
   end;
  end;
  S:=A[N-1,N-1];
  if abs(S)<Eps then err:=err+1;
  for i:=N-1 downto 0 do begin
   S:=0; for j:=i+1 to N-1 do S:=S+A[i,j]*X[j];
   X[i]:=(Y[i]-S)/A[i,i];
  end;
  Solve:=err;
 end;
 procedure CreateEquations(crv,N:Integer; Center,Scale:Real; var A:TMatrix; var P,Q:TVector);
 var i,j,k,NumPoints:Integer; Pw,t,Yi:Real; b:Boolean;
 begin
  b:=CrvLock(crv);
  NumPoints:=Round(CrvLen(crv));
  for j:=0 to N-1 do begin
   Q[j]:=0;
   for k:=0 to N-1 do A[j,k]:=0;
  end;
  for i:=0 to NumPoints-1 do begin
   t:=(CrvX(crv,1+i)-Center)/Scale;
   Pw:=1;
   for j:=0 to N-1 do begin
    P[j]:=Pw;
    Pw:=Pw*t;
   end;
   for j:=0 to N-1 do
   for k:=0 to N-1 do A[j,k]:=A[j,k]+P[j]*P[k];
   Yi:=CrvY(crv,1+i);
   for j:=0 to N-1 do Q[j]:=Q[j]+Yi*P[j];
  end;
  b:=CrvUnLock(crv);
 end;
begin
 PolynomFind:=False;
 Poly.Power:=0;
 Poly.Scale:=0;
 Poly.Center:=0;
 for i:=0 to 9 do Poly.Coeff[i]:=0;
 if Scale>0 then
 if CrvLen(crv)>0 then
 if not IsNan(Scale) then
 if not IsInf(Scale) then
 if not IsNan(Center) then
 if not IsInf(Center) then
 if (Power>=0) and (Power<=9) then begin
  CreateEquations(crv,Power+1,Center,Scale,A,P,Q);
  if Solve(Power+1,A,P,Q,Eps)=0 then begin
   Poly.Power:=Power;
   Poly.Scale:=Scale;
   Poly.Center:=Center;
   for i:=0 to 9 do Poly.Coeff[i]:=P[i];
   PolynomFind:=True;
  end;
 end;
end;
