 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2002, <kouriakine@mail.ru>
 Calibration routines.
 Modifications:
 20020205 - Creation (uses CRW16) & test
 20030329 - Struggle for safety (add some try/except checks)...
 20161016 - GetX, polynomcalib_inv, InitRtdTc
 20161020 - IsFixed, NameW
 20161021 - modify polynomcalib_ttc to have better performance & robustness
 20170222 - TextAddMetaData, FileCheckMetaData
 20190601 - Eval(v):ln(v):exp(v):1e-100:1e100, Evaluator, ExtractCalibEvalItem
 ****************************************************************************
 }
unit _calib; { calibrations }

{$I _sysdef}

interface

uses
 sysutils, windows, classes, math, _alloc, _fifo, _str, _fio, _fpu, _plut,
 _dynar, _lsqpoly, _couple, _rtdtc, _zm, _meta, _ee;

 {
  TPolynomCalibration - полиномиальная калибровка - базовый обьект
 для калибровок полиномиального типа, когда идет МНК-подгонка
 коэффициентов калибровочного полинома.
  В типичной ситуации калибровка канала должна описывать закон
                         y=Y(x,z),
 по которому аргумент х  преобразуется в физическую величину y
 при данном параметре z (зависимость от z может и не присутствовать).
 Предполагается, что зависимость от x определяется аппаратурой
 и подлежит определению, а зависимость от параметра z точно известна.
 Предполагается также, что известна пара взаимно-однозначных (назовем
 их линеаризующими) преобразований:
           x'=fx(x,z), x=gx(x',z)
           y'=fy(y,z), y=gy(y',z)
 обладающих тем свойством, что в 'линеаризованных' переменных
 зависимость y'(x') не зависит от z и является гладкой функцией,
 а следовательно, может быть подогнана полиномом y'=p(x').
 Линеаризующие функции заданы аналитически и зависят от типа
 калибруемых данных, а коэффициенты полинома подгоняются по МНК.
 Таким образом, в общем случае зависимость имеет вид
           y=gy(p(fx(x,z)),z),
 а подгонка полинома p(x) идет в линеаризованных переменных x',y'.
 Конечно, зависимость от параметра z, а также линеаризующее
 преобразование необязательны. Проиллюстрируем сказанное тремя
 примерами.
  Пример 1: обычная калибровка канала АЦП.
 Ищется обычный полином y=p(x). Зависимость от z отсутствует, функции
 fx,fy - тождественные преобразования
   x'=fx(x,z)=x, x=gx(x',z)=x'
   y'=fy(y,z)=y, y=gy(y',z)=y'
  Пример 2: дважды логарифмическая шкала.
 Ищется зависимость y=exp(p(log(x))). Зависимость от z отсутствует,
 линеаризующие преобразования
   x'=fx(x,z)=log(x), x=gx(x',z)=exp(x')
   y'=fy(y,z)=log(y), y=gy(y',z)=exp(y')
  Пример 3: калибровка термопарного канала.
  АЦП измеряет термоЭДС y' термопары при непостоянной температуре
 холодного спая z. Зависимости между термоЭДС y', температурой y и
 температурой холодного спая z описывается как
   y'=fy(y,z)=F(y)-F(z),  y=gy(y',z)=G(y'+F(z))
 где F-термопарная таблица термоЭДС-температура, известная по
 таблицам ГОСТ, G-обратная к F функция. Если термоЭДС измеряется
 при помощи АЦП, то между кодом АЦП x и термоЭДС y' есть полиномиальная
 зависимость типа y'=p(x), например, линейная, так что преобразование
 имеет конечный вид
   y=G(p(x)+F(z))
  Пример 3: смещение нуля.
 Если один из каналов мультиплексируемого АЦП закорочен, можно сказать,
 что истинное значение напряжения y в канале равно y=x-z, где x-измеренное
 значение, z-измеренное значение на закоротке.
 В этом случае линеаризующим будет преобразование
   x'=fx(x,z)=x-z, x=gx(x',z)=x'+z
  Поскольку в калибровках хранятся исходные точки x,y,z, а коэффициенты
 полинома вычисляются по мере необходимости, то калибровка позволяет легко
 менять параметры описания зависимости без потери точности.
 }

const
 MaxCalibNamesLeng = 31;             { макс. длина имен  калибровок }
 MaxCalibTransItem = 128;            { макс. число типов калибровок }
 id_CalibEvalAlias = 'EVAL(V)';      { псевдоним формульной шкалы   }

type
 PCalibTransformItem = ^TCalibTransformItem;
 TCalibEvalBuffer    = packed array[byte] of char;
 TCalibTransformFunc = function(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
 TCalibTransformItem = packed record { задает тип калибровки             }
  Funct : TCalibTransformFunc;       { функция преобразования            }
  Descr : ShortString;               { описатель функции                 }
  RangA : Double;                    { нижний допустимый предел          }
  RangB : Double;                    { верхний допустимый предел         }
  Param : Double;                    { дополнительный параметр-константа }
  Owner : TObject;                   { Owner calibration object          }
  EvalF : TCalibEvalBuffer;          { Evaluate forward  formula         }
  EvalI : TCalibEvalBuffer;          { Evaluate inversed formula         }
 end;

function CalibTransformItem(aFunct : TCalibTransformFunc;
                      const aDescr : ShortString;
                            aRangA : Double;
                            aRangB : Double;
                            aParam : Double):TCalibTransformItem;

function FormatCalibTransformItem(const Item:TCalibTransformItem):ShortString;

 {
 Список всех преобразований
 }
type
 TCalibTransformList = class(TMasterObject)
 private
  myCount   : Integer;
  myItems   : packed array[0..MaxCalibTransItem-1] of TCalibTransformItem;
  function    GetCount:Integer;
  function    GetItems(i:Integer):TCalibTransformItem;
  function    GetText:LongString;
 public
  property    Count            : Integer             read GetCount;
  property    Items[i:Integer] : TCalibTransformItem read GetItems; default;
  property    Text             : LongString          read GetText;
 public
  constructor Create;
  destructor  Destroy; override;
  function    Add(const aItem:TCalibTransformItem):Boolean;
  function    Find(const aName:ShortString):TCalibTransformItem;
  procedure   InitThermocouples;
  procedure   InitRelations;
 end;

const
 CalibTransformList : TCalibTransformList = nil;

 {
 TCalibPoint описывает одну калибровочную точку
 x - обычно милливольты АЦП
 y - физическая величина, например, температура
 w - весовой фактор, обратная дисперсия
 z - дополнительный параметр, например, температура холодного спая
 }
type
 TCalibPoint = packed record x,y,w,z : Double; end;

function CalibPoint(x,y,w,z:Double):TCalibPoint;

 {
 Формульное калибровочное преобразование описывается строкой
     EVAL(V):LN(V):EXP(V):1E-100:1E100
 где EVAL(V) - псевдоним формульного преобразования
     LN(V)   - прямое (линеаризующее) преобразование
     EXP(V)  - обратное преобразование
     1E-100  - нижний предел аргумента
     1E100   - верхний предел аргумента
 }

 {
 ExtractCalibEvalItem - Extract n-th word of :-delimeted expression like Eval(v):ln(v):exp(v):1e-100:1e100
 ExtractCalibAlias    - Extract 1-st word of :-delimeted expression like Eval(v):ln(v):exp(v):1e-100:1e100
 IsSameCalibAlias     - Compare two (a,b) calibration transformation descriptions by alias
                   e.g. 'Eval(v):ln(v):exp(v):1e-100:1e100' has same alias as 'EVAL(V)'
 }
function ExtractCalibEvalItem(n:Integer; const s:ShortString):ShortString;
function ExtractCalibAlias(const s:ShortString):ShortString;
function IsSameCalibAlias(const a,b:ShortString):Boolean;

 {
 Калибровка
 }
type
 TPolynomCalibration = class(TLatch)
 private
  myLockUpdate : Integer;
  myIsValid    : Boolean;
  myIsFixed    : Boolean;
  myCount      : Integer;
  myDataX      : PDoubleArray;
  myDataY      : PDoubleArray;
  myDataW      : PDoubleArray;
  myDataZ      : PDoubleArray;
  myNameX      : String[MaxCalibNamesLeng];
  myNameY      : String[MaxCalibNamesLeng];
  myNameZ      : String[MaxCalibNamesLeng];
  myTransformX : TCalibTransformItem;
  myTransformY : TCalibTransformItem;
  myEvaluator  : TExpressionEvaluator;
  myPoly       : TPolynom;
  myBoundA     : Double;
  myBoundB     : Double;
  myNote       : TText;
  myFileName   : ShortString;
  function    GetIsValid:Boolean;
  function    GetIsFixed:Boolean;
  procedure   SetIsFixed(aFixed:Boolean);
  function    GetCapacity:Integer;
  function    GetCount:Integer;
  function    GetItems(i:Integer):TCalibPoint;
  function    GetNameX:ShortString;
  procedure   SetNameX(const aName:ShortString);
  function    GetNameY:ShortString;
  procedure   SetNameY(const aName:ShortString);
  function    GetNameZ:ShortString;
  procedure   SetNameZ(const aName:ShortString);
  function    GetNameW:ShortString;
  function    GetTransformX:ShortString;
  procedure   SetTransformX(const aDescr:ShortString);
  function    GetTransformY:ShortString;
  procedure   SetTransformY(const aDescr:ShortString);
  function    GetTransformRange:TRect2D;
  function    GetEvaluator:TExpressionEvaluator;
  function    GetPower:Integer;
  procedure   SetPower(aPower:Integer);
  function    GetCenter:Double;
  procedure   SetCenter(aCenter:Double);
  function    GetScale:Double;
  procedure   SetScale(aScale:Double);
  function    GetCoeff(i:Integer):Double;
  procedure   SetCoeff(i:Integer; aCoeff:Double);
  function    GetBoundA:Double;
  procedure   SetBoundA(aBound:Double);
  function    GetBoundB:Double;
  procedure   SetBoundB(aBound:Double);
  function    GetItemsRange:TRect2D;
  function    GetNote:TText;
  function    GetFileName:ShortString;
  procedure   SetFileName(const aName:ShortString);
  procedure   DebugMessage(const Msg:ShortString);
 public
  property    IsValid          : Boolean     read GetIsValid;
  property    IsFixed          : Boolean     read GetIsFixed    write SetIsFixed;
  property    Capacity         : Integer     read GetCapacity;
  property    Count            : Integer     read GetCount;
  property    Items[i:Integer] : TCalibPoint read GetItems;     default;
  property    NameX            : ShortString read GetNameX      write SetNameX;
  property    NameY            : ShortString read GetNameY      write SetNameY;
  property    NameZ            : ShortString read GetNameZ      write SetNameZ;
  property    NameW            : ShortString read GetNameW;
  property    TransformX       : ShortString read GetTransformX write SetTransformX;
  property    TransformY       : ShortString read GetTransformY write SetTransformY;
  property    TransformRange   : TRect2D     read GetTransformRange;
  property    Evaluator        : TExpressionEvaluator read GetEvaluator;
  property    Power            : Integer     read GetPower      write SetPower;
  property    Center           : Double      read GetCenter     write SetCenter;
  property    Scale            : Double      read GetScale      write SetScale;
  property    Coeff[i:Integer] : Double      read GetCoeff      write SetCoeff;
  property    BoundA           : Double      read GetBoundA     write SetBoundA;
  property    BoundB           : Double      read GetBoundB     write SetBoundB;
  property    ItemsRange       : TRect2D    read GetItemsRange;
  property    Note             : TText       read GetNote;
  property    FileName         : ShortString read GetFileName   write SetFileName;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   Assign(Source:TPolynomCalibration);
  procedure   Clear;
  function    LinearX(ax,az:Double; Linear:Boolean):Double;
  function    LinearY(ay,az:Double; Linear:Boolean):Double;
  function    GetY(ax,az:Double):Double;
  function    GetX(ay,az:Double):Double;
  procedure   LockUpdate;
  procedure   UnlockUpdate;
  procedure   Update;
  function    Insert(aCalibPoint:TCalibPoint):Boolean;
  procedure   Delete(Index:Integer);
  function    GetText(const SectionName:ShortString):LongString;
  function    SaveToFile(const aFileName    : ShortString;
                         const aSectionName : ShortString='';
                               IsAppend     : Boolean=false):Boolean;
  function    LoadFromFile(const aFileName    : ShortString;
                           const aSectionName : ShortString=''):Boolean;
 end;

type
 PPolynomCalibrationArray = ^TPolynomCalibrationArray;
 TPolynomCalibrationArray = array[0..MaxInt div sizeof(TPolynomCalibration)-1] of TPolynomCalibration;

function  NewCalibration(const aNameX  : String = 'X';
                         const aNameY  : String = 'Y';
                         const aNameZ  : String = '';
                         const aTranX  : String = 'Line';
                         const aTranY  : String = 'Line';
                               aPower  : Integer     = 1;
                               aCenter : Double      = 0;
                               aScale  : Double      = 1;
                               aBoundA : Double      = -1e4;
                               aBoundB : Double      = +1e4;
                         const aNote   : LongString  = ''
                                     ) : TPolynomCalibration;
function  NewCalibrationLoadFromFile(const aNameX       : String;
                                     const aNameY       : String;
                                     const aNameZ       : String;
                                     const aFileName    : String;
                                     const aSectionName : String
                                                      ) : TPolynomCalibration;
function  NewCalibrationSmartLoadFromFile(const aFileName:ShortString):TPolynomCalibration;
procedure Kill(var TheObject:TPolynomCalibration); overload;

const
 polynomcalib_cnt : Int64   = 0;      // Call counter
 polynomcalib_eps : Double  = 1E-15;  // Epsilon
 polynomcalib_tol : Double  = 1E-14;  // Tolerance
 polynomcalib_big : Double  = 1E+14;  // big range value
 polynomcalib_del : Double  = 0;      // line ext. delta
 polynomcalib_fac : Double  = 2;      // grow factor
 polynomcalib_met : Integer = 1;      // 1=ZeroIn, 2=Bisection
 polynomcalib_mit : Integer = 128;    // Max.iterations

function polynomcalib_inv(const y,z:Double; cal:TPolynomCalibration):Double;

implementation

const
 LockUnlockBalance : LongInt = 0;
 
 {
 *******************************************************************************
 Creation / Destruction
 *******************************************************************************
 }
function  NewCalibration(const aNameX  : String = 'X';
                         const aNameY  : String = 'Y';
                         const aNameZ  : String = '';
                         const aTranX  : String = 'Line';
                         const aTranY  : String = 'Line';
                               aPower  : Integer     = 1;
                               aCenter : Double      = 0;
                               aScale  : Double      = 1;
                               aBoundA : Double      = -1e4;
                               aBoundB : Double      = +1e4;
                         const aNote   : LongString  = ''
                                     ) : TPolynomCalibration;
begin
 Result:=nil;
 try
  Result:=TPolynomCalibration.Create;
  if Result.Ok then begin
   Result.LockUpdate;
   Result.NameX:=aNameX;
   Result.NameY:=aNameY;
   Result.NameZ:=aNameZ;
   Result.TransformX:=aTranX;
   Result.TransformY:=aTranY;
   Result.Power:=aPower;
   Result.Center:=aCenter;
   Result.Scale:=aScale;
   Result.BoundA:=aBoundA;
   Result.BoundB:=aBoundB;
   Result.Note.Text:=aNote;
   Result.UnlockUpdate;
  end else Kill(Result);
 except
  on E:Exception do begin
   BugReport(E);
   Kill(Result);
  end;
 end;
end;

function  NewCalibrationLoadFromFile(const aNameX       : String;
                                     const aNameY       : String;
                                     const aNameZ       : String;
                                     const aFileName    : String;
                                     const aSectionName : String
                                                      ) : TPolynomCalibration;
begin
 Result:=nil;
 try
  Result:=NewCalibration(aNameX,aNameY,aNameZ);
  if not Result.LoadFromFile(aFileName,aSectionName) then Kill(Result);
 except
  on E:Exception do begin
   BugReport(E);
   Kill(Result);
  end;
 end;
end;

function NewCalibrationSmartLoadFromFile(const aFileName:ShortString):TPolynomCalibration;
var p:TText; i:Integer; nx,ny,nz:ShortString;
begin
 Result:=nil;
 if FileExists(aFileName) then begin
  nx:='';
  ny:='';
  nz:='';
  p:=NewText;
  p.ReadFile(aFileName);
  for i:=0 to p.Count-1 do
  if (WordIndex('DATA',  UnifyAlias(p[i]),ScanSpaces)=1) and
     (WordIndex('WEIGHT',UnifyAlias(p[i]),ScanSpaces)=4)
  then begin
   nx:=ExtractWord(2,p[i],ScanSpaces);
   ny:=ExtractWord(3,p[i],ScanSpaces);
   nz:=ExtractWord(5,p[i],ScanSpaces);
   break;
  end;
  Kill(p);
  if (Length(nx)>0) and (Length(ny)>0)
  then Result:=NewCalibrationLoadFromFile(nx,ny,nz,aFileName,'');
 end;
end;

procedure Kill(var TheObject:TPolynomCalibration); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end;
end;

 {
 *******************************************************************************
 Общие утилиты
 Группа функций преобразования для калибровок:
 LineTransformer   - Нет преобразования (линейная шкала)
 LogTransformer    - Преобразование по логарифмической шкале Log/Exp
 CoupleTransformer - Группа функций преобразования для калибровок термопар
                     В данном случае y соответствует температуре 'горячего' спая,
                     либо термоЭДС,  z сответствует температуре 'холодного' спая
                     При Linear=true  преобразует температуру в термоЭДС
                     При Linear=false преобразует термоЭДС в температуру
                     P=номер термопарной таблицы
 CoupleTransformer - Группа функций преобразования для табличных термопар
                     В данном случае y соответствует физ.величине или
                     милливольтам, z не используется,
                     При Linear=true  преобразует физ.величину в милливольты
                     При Linear=false преобразует милливольты в физ.величину
                     P=номер калибровочной таблицы
 *******************************************************************************
 }
function CalibTransformItem(aFunct : TCalibTransformFunc;
                      const aDescr : ShortString;
                            aRangA : Double;
                            aRangB : Double;
                            aParam : Double):TCalibTransformItem;
begin
 FillChar(Result,sizeof(Result),0);
 Result.Funct:=aFunct;
 Result.Descr:=Trim(aDescr);
 Result.RangA:=aRangA;
 Result.RangB:=aRangB;
 Result.Param:=aParam;
 Result.Owner:=nil;
 Result.EvalF:='';
 Result.EvalI:='';
end;

function FormatCalibTransformItem(const Item:TCalibTransformItem):ShortString;
begin
 with Item do
 Result:=Format('%-*s %-14.7g %-14.7g', [MaxCalibNamesLeng, ExtractCalibAlias(Descr), RangA, RangB]);
end;

function CalibPoint(x,y,w,z:Double):TCalibPoint;
begin
 Result.x:=x;
 Result.y:=y;
 Result.w:=w;
 Result.z:=z;
end;

function ExtractCalibEvalItem(n:Integer; const s:ShortString):ShortString;
begin
 if n>1
 then Result:=ExtractWord(n,s,[':'])
 else Result:=ExtractWord(n,s,[':',#0..' ']);
end;

function ExtractCalibAlias(const s:ShortString):ShortString;
begin
 Result:=ExtractCalibEvalItem(1,s);
end;

function IsSameCalibAlias(const a,b:ShortString):Boolean;
begin
 Result:=SameText(ExtractCalibEvalItem(1,a),ExtractCalibEvalItem(1,b));
end;

function LineTransformer(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 Result:=ay;
end;

function LgTransformer(ay,az:Double; Linear:boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 if Linear then Result:=LogN(P,ay) else Result:=Power(P,ay);
end;

function SubZTransformer(ay,az:Double; Linear:boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 if Linear then Result:=ay-az else Result:=ay+az;
end;

function AddZTransformer(ay,az:Double; Linear:boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 if Linear then Result:=ay+az else Result:=ay-az;
end;

function CoupleTransformer(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 if Linear
 then Result:=ThermoCouple(round(P),ay,false)-ThermoCouple(round(P),az,false)
 else Result:=ThermoCouple(round(P),ay+ThermoCouple(round(P),az,false),true);
end;

function RelationTransformer(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
begin
 if Linear
 then Result:=Relationship(round(P),ay,false)
 else Result:=Relationship(round(P),ay,true);
end;

function RtdTransformer(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
var idn:Integer;
begin
 idn:=round(P);
 if Linear
 then Result:=restemperdet_ohm(ay,idn)
 else Result:=restemperdet_ttc(ay,idn);
end;

function TcTransformer(ay,az:Double; Linear:Boolean; P:Double; Item:PCalibTransformItem):Double;
var idn:Integer;
begin
 idn:=round(P);
 if Linear
 then Result:=thermocouple_emf(ay,idn)-thermocouple_emf(az,idn)
 else Result:=thermocouple_ttc(ay+thermocouple_emf(az,idn),idn);
end;

procedure InitRtdTcTransformers;
 procedure InitTcTransformer(idn:Integer);
 begin
  if length(thermocouple_ids(idn))>0 then
  with CalibTransformList do
  Add(CalibTransformItem(TcTransformer, Format('CALC_TC_%s',[thermocouple_ids(idn)]),
      thermocouple_lot(idn), thermocouple_hit(idn), idn));
 end;
 procedure InitRtdTransformer(idn:Integer);
 begin
  if length(restemperdet_ids(idn))>0 then
  with CalibTransformList do
  Add(CalibTransformItem(RtdTransformer, Format('CALC_RTD_%s',[restemperdet_ids(idn)]),
      restemperdet_lot(idn), restemperdet_hit(idn), idn));
 end;
begin
 InitTcTransformer(thermocouple_R);
 InitTcTransformer(thermocouple_S);
 InitTcTransformer(thermocouple_B);
 InitTcTransformer(thermocouple_J);
 InitTcTransformer(thermocouple_T);
 InitTcTransformer(thermocouple_E);
 InitTcTransformer(thermocouple_K);
 InitTcTransformer(thermocouple_N);
 InitTcTransformer(thermocouple_A1);
 InitTcTransformer(thermocouple_A2);
 InitTcTransformer(thermocouple_A3);
 InitTcTransformer(thermocouple_L);
 InitTcTransformer(thermocouple_M);
 InitRtdTransformer(rtd_id_pt100_385);
 InitRtdTransformer(rtd_id_pt100_391);
 InitRtdTransformer(rtd_id_cu100_428);
 InitRtdTransformer(rtd_id_cu100_426);
 InitRtdTransformer(rtd_id_ni100_617);
end;

function EvalTransformer(ay,az:Double; Linear:boolean; P:Double; Item:PCalibTransformItem):Double;
var ee:TExpressionEvaluator;
begin
 Result:=_NaN;
 if (Item=nil) then Exit;
 if (Item.Owner=nil) then Exit;
 if not (Item.Owner is TPolynomCalibration) then exit;
 ee:=TPolynomCalibration(Item.Owner).Evaluator;
 if not ee.SetValue('v',ay) then Exit;
 if not ee.SetValue('p',az) then Exit;
 if Linear then begin
  if ee.EvaluateExpression(Item.EvalF)<>ee_Ok then exit;
  Result:=ee.Answer;
 end else begin
  if ee.EvaluateExpression(Item.EvalI)<>ee_Ok then exit;
  Result:=ee.Answer;
 end;
end;

 // Eval(v):sqrt(v):sqr(v):0:1E300
function TrySetCalibTransformEval(var Item:TCalibTransformItem; const Descr:ShortString):Boolean;
var w1,w2,w3,w4,w5:ShortString; ra,rb:Double;
begin
 Result:=false;
 try
  w1:=ExtractCalibEvalItem(1,Descr); if (w1='') then exit; if not SameText(w1,id_CalibEvalAlias) then exit;
  w2:=ExtractCalibEvalItem(2,Descr); if (w2='') then exit;
  w3:=ExtractCalibEvalItem(3,Descr); if (w3='') then exit;
  w4:=ExtractCalibEvalItem(4,Descr); if (w4='') then exit; if not Str2Real(w4,ra) then exit;
  w5:=ExtractCalibEvalItem(5,Descr); if (w5='') then exit; if not Str2Real(w5,rb) then exit;
  Item.Descr:=Descr;
  Item.Funct:=EvalTransformer;
  StrPCopy(Item.EvalF,w2);
  StrPCopy(Item.EvalI,w3);
  Item.RangA:=ra;
  Item.RangB:=rb;
 except
  on E:Exception do BugReport(E,nil,'TrySetCalibTransformEval');
 end;
end;

 {
 *******************************************************************************
 TCalibTransformList implementation
 *******************************************************************************
 }
const
 DefaultCalibTransformItem:TCalibTransformItem=
 (Funct:LineTransformer; Descr:'Line'; RangA:-1e300; RangB:+1e300; Param:0.0; Owner:nil; EvalF:''; EvalI:'');

function TCalibTransformList.GetCount:Integer;
begin
 if Assigned(Self) then Result:=myCount else Result:=0;
end;

function TCalibTransformList.GetItems(i:Integer):TCalibTransformItem;
begin
 if Cardinal(i)<Cardinal(Count)
 then Result:=myItems[i]
 else Result:=DefaultCalibTransformItem;
end;

function TCalibTransformList.GetText:LongString;
var p:TText; i:Integer;
begin
 p:=NewText;
 for i:=0 to Count-1 do p.Addln(FormatCalibTransformItem(Items[i]));
 Result:=p.Text;
 Kill(p);
end;

constructor TCalibTransformList.Create;
begin
 inherited Create;
 myCount:=0;
 SafeFillChar(myItems,sizeof(myItems),0);
end;

destructor TCalibTransformList.Destroy;
begin
 myCount:=0;
 SafeFillChar(myItems,sizeof(myItems),0);
 inherited Destroy;
end;

function TCalibTransformList.Add(const aItem:TCalibTransformItem):Boolean;
var i:Integer;
begin
 Result:=false;
 if Ok and Assigned(aItem.Funct) and not IsEmptyStr(aItem.Descr) then begin
  for i:=0 to myCount-1 do
  if IsSameCalibAlias(myItems[i].Descr,aItem.Descr) then begin
   myItems[i]:=aItem;
   Result:=true;
   break;
  end;
  if not Result then
  if myCount<=High(myItems) then begin
   myItems[myCount]:=aItem;
   Result:=true;
   inc(myCount);
  end;
 end;
end;

function TCalibTransformList.Find(const aName:ShortString):TCalibTransformItem;
var i:Integer;
begin
 Result:=DefaultCalibTransformItem;
 if Ok and not IsEmptyStr(aName) then
 for i:=0 to Count-1 do
 if IsSameCalibAlias(Items[i].Descr,aName) then begin
  Result:=Items[i];
  break;
 end;
end;

procedure TCalibTransformList.InitThermocouples;
var i:Integer;
begin
 if ThermoCoupleCount=0
 then InitCouples(SysIniFile,'[DataBase]','ThermoCouples',stdfDebug);
 for i:=0 to ThermoCoupleCount-1 do
 with ThermoCoupleRange(i) do
 Add(CalibTransformItem(CoupleTransformer, ThermoCoupleName(i), a.x, b.x, i));
end;

procedure TCalibTransformList.InitRelations;
var i:Integer;
begin
 if RelationshipCount=0
 then InitRelationShips(SysIniFile,'[DataBase]','Relationships',stdfDebug);
 for i:=0 to RelationShipCount-1 do
 with RelationshipRange(i) do
 Add(CalibTransformItem(RelationTransformer, RelationshipName(i), a.x, b.x, i));
end;

 {
 *******************************************************************************
 TPolynomCalibration implementation
 *******************************************************************************
 }
 {
 Вспомогательная процедура - отсортировать массивы (x,y,z) по неубыванию x
 }
procedure QuickSortDoubleXYWZ(var x,y,w,z:array of Double; N:Integer);
 procedure Sort(l,r:Integer);
 var i,j:Integer; c:Double;
 begin
  i:=l;
  j:=r;
  c:=x[(l+r) shr 1];
  repeat
   while x[i]<c do inc(i);
   while c<x[j] do dec(j);
   if i<=j then begin
    ExchangeVar(x[i],x[j]);
    ExchangeVar(y[i],y[j]);
    ExchangeVar(w[i],w[j]);
    ExchangeVar(z[i],z[j]);
    inc(i);
    dec(j);
   end;
  until i>j;
  if l<j then Sort(l,j);
  if i<r then Sort(i,r);
 end;
begin
 if N>1 then Sort(0,N-1);
end;

function TPolynomCalibration.GetIsValid:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myIsValid;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetIsFixed:Boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myIsFixed;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;


procedure TPolynomCalibration.SetIsFixed(aFixed:Boolean);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myIsFixed:=aFixed;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetCapacity:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=min(min(AllocSize(myDataX) div sizeof(myDataX[0]),
                   AllocSize(myDataY) div sizeof(myDataY[0])),
               min(AllocSize(myDataW) div sizeof(myDataW[0]),
                   AllocSize(myDataZ) div sizeof(myDataZ[0])));
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetCount:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myCount;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetItems(i:Integer):TCalibPoint;
begin
 Result:=CalibPoint(0,0,1,0);
 if Assigned(Self) then
 try
  Lock;
  try
   if Cardinal(i)<Cardinal(myCount)
   then Result:=CalibPoint(myDataX[i], myDataY[i], myDataW[i], myDataZ[i])
   else Result:=CalibPoint(0,0,1,0);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetNameX:ShortString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myNameX;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetNameX(const aName:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if not IsEmptyStr(aName) then
   myNameX:=Copy(Trim(aName),1,MaxCalibNamesLeng);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetNameY:ShortString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myNameY;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetNameY(const aName:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if not IsEmptyStr(aName) then
   myNameY:=Copy(Trim(aName),1,MaxCalibNamesLeng);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetNameZ:ShortString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myNameZ;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetNameZ(const aName:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myNameZ:=Copy(Trim(aName),1,MaxCalibNamesLeng);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetNameW:ShortString;
begin
 if Assigned(Self) then Result:='Weight' else Result:='';
end;

function TPolynomCalibration.GetTransformX:ShortString;
begin
 Result:=DefaultCalibTransformItem.Descr;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myTransformX.Descr;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetTransformX(const aDescr:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   myTransformX:=CalibTransformList.Find(aDescr);
   TrySetCalibTransformEval(myTransformX,aDescr);
   myTransformX.Owner:=Self;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetTransformY:ShortString;
begin
 Result:=DefaultCalibTransformItem.Descr;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myTransformY.Descr;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetTransformY(const aDescr:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   myTransformY:=CalibTransformList.Find(aDescr);
   TrySetCalibTransformEval(myTransformY,aDescr);
   myTransformY.Owner:=Self;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetTransformRange:TRect2D;
begin
 Result:=Rect2D(0,0,0,0);
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=Rect2D(myTransformX.RangA,myTransformY.RangA,myTransformX.RangB,myTransformY.RangB);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetEvaluator:TExpressionEvaluator;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   if (myEvaluator=nil) then begin
    myEvaluator:=NewExpressionEvaluator;
    myEvaluator.Master:=myEvaluator;
   end;
   Result:=myEvaluator;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetPower:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myPoly.Power;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetPower(aPower:Integer);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   myPoly.Power:=max(1,min(High(TPolynomPower),aPower));
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetCenter:Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myPoly.Center;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetCenter(aCenter:Double);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   myPoly.Center:=aCenter;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetScale:Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myPoly.Scale;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetScale(aScale:Double);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   myPoly.Scale:=abs(aScale)+ord(aScale=0);
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetCoeff(i:Integer):Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myPoly.Coeff[i];
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetCoeff(i:Integer; aCoeff:Double);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if myIsFixed then
   if (i>=Low(TPolynomPower)) then
   if (i<=High(TPolynomPower)) then
   myPoly.Coeff[i]:=aCoeff;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetBoundA:Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myBoundA;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetBoundA(aBound:Double);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myBoundA:=aBound;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetBoundB:Double;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myBoundB;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetBoundB(aBound:Double);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myBoundB:=aBound;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;


function TPolynomCalibration.GetItemsRange:TRect2D;
var i:Integer;
begin
 Result:=Rect2D(0,0,0,0);
 if Assigned(Self) then
 try
  Lock;
  try
   for i:=0 to Count-1 do with Items[i] do
   if i=0 then Result:=Rect2D(x,y,x,y) else begin
    Result.a.x:=Min(Result.a.x,x);
    Result.b.x:=Max(Result.b.x,x);
    Result.a.y:=Min(Result.a.y,y);
    Result.b.y:=Max(Result.b.y,y);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetNote:TText;
begin
 Result:=nil;
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myNote;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetFileName:ShortString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myFileName;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.SetFileName(const aName:ShortString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myFileName:=aName;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.DebugMessage(const Msg:ShortString);
var
 s : ShortString;
begin
 if Assigned(Self) then
 try
  s:=Format(RusEng('Калибровка %s-%s: %s','Calibration %s-%s: %s'),[NameX,NameY,Msg]);
  DebugOut(stdfDebug,s);
  Echo(s);
 except
  on E:Exception do ErrorFound(E);
 end;
end;

constructor TPolynomCalibration.Create;
begin
 inherited Create;
 Exceptions:=false;
 myLockUpdate:=0;
 LockUpdate;
 myIsValid:=false;
 myIsFixed:=false;
 myCount:=0;
 myDataX:=nil;
 myDataY:=nil;
 myDataW:=nil;
 myDataZ:=nil;
 NameX:='X';
 NameY:='Y';
 NameZ:='';
 TransformX:='Line';
 TransformY:='Line';
 myEvaluator:=nil;
 myPoly:=NewPolynom(1,0,1);
 myPoly.Coeff[0]:=0;
 myPoly.Coeff[1]:=1;
 myNote:=NewText;
 myNote.Master:=myNote;
 BoundA:=0;
 BoundB:=1;
 FileName:='';
 UnlockUpdate;
end;

destructor  TPolynomCalibration.Destroy;
begin
 Lock;
 try
  myIsValid:=false;
  myIsFixed:=false;
  myCount:=0;
  Deallocate(Pointer(myDataX));
  Deallocate(Pointer(myDataY));
  Deallocate(Pointer(myDataW));
  Deallocate(Pointer(myDataZ));
  NameX:='';
  NameY:='';
  NameZ:='';
  TransformX:='Line';
  TransformY:='Line';
  Kill(myEvaluator);
  Kill(myPoly);
  BoundA:=0;
  BoundB:=1;
  Kill(myNote);
  FileName:='';
 finally
  Unlock;
 end;
 inherited Destroy;
end;

procedure TPolynomCalibration.Assign(Source:TPolynomCalibration);
var i:Integer;
begin
 if Assigned(Self) and (Source is TPolynomCalibration) then
 try
  Lock;
  try
   LockUpdate;
   Clear;
   NameX:=Source.NameX;
   NameY:=Source.NameY;
   NameZ:=Source.NameZ;
   TransformX:=Source.TransformX;
   TransformY:=Source.TransformY;
   Power:=Source.Power;
   Center:=Source.Center;
   Scale:=Source.Scale;
   BoundA:=Source.BoundA;
   BoundB:=Source.BoundB;
   IsFixed:=Source.IsFixed;
   if IsFixed then for i:=0 to Power do Coeff[i]:=Source.Coeff[i];
   for i:=0 to Source.Count-1 do Insert(Source[i]);
   Note.Text:=Source.Note.Text;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.Clear;
var i:Integer;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myCount:=0;
   myIsValid:=false;
   myPoly.Power:=1;
   myPoly.Coeff[0]:=0;
   myPoly.Coeff[1]:=1;
   for i:=2 to High(TPolynomPower) do myPoly.Coeff[i]:=0;
   myNote.Count:=0;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.LinearX(ax,az:Double; Linear:Boolean):Double;
begin
 Result:=ax;
 if Assigned(Self) then
 try
  Lock;
  try
   with myTransformX do Result:=Funct(ax,az,Linear,Param,@myTransformX);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.LinearY(ay,az:Double; Linear:Boolean):Double;
begin
 Result:=ay;
 if Assigned(Self) then
 try
  Lock;
  try
   with myTransformY do Result:=Funct(ay,az,Linear,Param,@myTransformY);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetY(ax,az:double):Double;
begin
 Result:=ax;
 if Assigned(Self) then
 try
  Lock;
  try
   if myIsValid
   then Result:=LinearY(myPoly.Get(LinearX(ax,az,true)),az,false)
   else Result:=ax;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetX(ay,az:double):Double;
begin
 Result:=ay;
 if Assigned(Self) then
 try
  Lock;
  try
   if myIsValid
   then Result:=polynomcalib_inv(ay,az,Self)
   else Result:=ay;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.LockUpdate;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   inc(myLockUpdate);
   LockedInc(LockUnlockBalance);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.UnlockUpdate;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if myLockUpdate>0 then dec(myLockUpdate) else myLockUpdate:=0;
   if myLockUpdate=0 then Update;
   LockedDec(LockUnlockBalance);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.Update;
var vx,vy:PDoubleArray; i,nz:integer;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Capacity < Count then Clear else begin
   if myCount>1 then QuickSortDoubleXYWZ(myDataX[0],myDataY[0],myDataW[0],myDataZ[0],myCount);
    if myIsFixed then begin
     myIsValid:=(myPoly.Power>=1); nz:=0;
     for i:=Low(TPolynomPower) to High(TPolynomPower) do begin
      if i>myPoly.Power then myPoly.Coeff[i]:=0;
      if isNaN(myPoly.Coeff[i]) then myIsValid:=false;
      if isInf(myPoly.Coeff[i]) then myIsValid:=false;
      if (i>0) and (myPoly.Coeff[i]<>0) then inc(nz);
     end;
     if nz=0 then myIsValid:=false;
     if not myIsValid then DebugMessage(RusEng('Недопустимые коэффициенты!','Invalid coefficients!'));
    end else begin
     myIsValid:=false;
     if myCount>myPoly.Power then begin
      vx:=Allocate(myCount*sizeof(Double));
      vy:=Allocate(myCount*sizeof(Double));
      try
       if min(AllocSize(vx),AllocSize(vy))=myCount*sizeof(Double) then begin
        for i:=0 to myCount-1 do begin
         vx[i]:=LinearX(myDataX[i],myDataZ[i],true);
         vy[i]:=LinearY(myDataY[i],myDataZ[i],true);
         if IsNanOrInf(vx[i]) or IsNanOrInf(vy[i]) then begin
          DebugMessage(RusEng('Ошибка FPU при вычислении калибровки.',
                              'FPU error in calibration calculation.'));
          Deallocate(Pointer(vx));
          Deallocate(Pointer(vy));
          break;
         end;
        end;
        if Assigned(vx) and Assigned(vy) then
        myIsValid:=myPoly.FindWeight(vx[0],vy[0],myDataW[0],myCount);
       end;
      finally
       Deallocate(Pointer(vx));
       Deallocate(Pointer(vy));
      end;
      if (myCount>myPoly.Power) and not myIsValid
      then DebugMessage(RusEng('Плохо определенная система при вычислении калибровки!',
                               'Ill condition linear set in calibration calculations!'));
     end;
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do begin
   ErrorFound(E);
   Clear;
  end;
 end;
end;

function TPolynomCalibration.Insert(aCalibPoint:TCalibPoint):Boolean;
var i:integer; lx,ly:double;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   if aCalibPoint.w<=0
   then DebugMessage(RusEng('Недопустимый '+NameW+' фактор!','Invalid '+NameW+' factor!'))
   else if (aCalibPoint.x<myTransformX.RangA) or (aCalibPoint.x>myTransformX.RangB)
   then DebugMessage(NameX+RusEng(' не в диапазоне!',' not in range!'))
   else if (aCalibPoint.y<myTransformY.RangA) or (aCalibPoint.y>myTransformY.RangB)
   then DebugMessage(NameY+RusEng(' не в диапазоне!',' not in range!'))
   else begin
    lx:=LinearX(aCalibPoint.x, aCalibPoint.z, true);
    ly:=LinearY(aCalibPoint.y, aCalibPoint.z, true);
    if IsNanOrInf(lx) or IsNanOrInf(ly)
    then DebugMessage(RusEng('Ошибка FPU при вычислении калибровки.',
                             'FPU error in calibration calculation.'))
    else begin
     {коррекция предела}
     myBoundA:=min(myBoundA, aCalibPoint.x);
     myBoundB:=max(myBoundB, aCalibPoint.x);
     {может быть,такая точка уже есть?}
     for i:=0 to myCount-1 do
     if myDataX[i]=aCalibPoint.x then begin
      myDataY[i]:=aCalibPoint.y;
      myDataW[i]:=aCalibPoint.w;
      myDataZ[i]:=aCalibPoint.z;
      Result:=true;
     end;
     {проверить наличие места для новой точки и выделить если надо}
     if not Result then begin
      if Capacity < Count+1 then begin
       Reallocate(Pointer(myDataX),AdjustBufferSize(myCount+1,16)*sizeof(myDataX[0]));
       Reallocate(Pointer(myDataY),AdjustBufferSize(myCount+1,16)*sizeof(myDataY[0]));
       Reallocate(Pointer(myDataW),AdjustBufferSize(myCount+1,16)*sizeof(myDataW[0]));
       Reallocate(Pointer(myDataZ),AdjustBufferSize(myCount+1,16)*sizeof(myDataZ[0]));
      end;
      if Capacity >= Count+1 then begin
       {добавить точку}
       myDataX[myCount]:=aCalibPoint.x;
       myDataY[myCount]:=aCalibPoint.y;
       myDataW[myCount]:=aCalibPoint.w;
       myDataZ[myCount]:=aCalibPoint.z;
       inc(myCount);
       Result:=true;
      end;
     end;
    end;
   end;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

procedure TPolynomCalibration.Delete(index:Integer);
var i:Integer;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   if (Cardinal(index)<Cardinal(myCount)) and (Capacity >= Count) then begin
    for i:=index to myCount-2 do begin
     myDataX[i]:=myDataX[i+1];
     myDataY[i]:=myDataY[i+1];
     myDataW[i]:=myDataW[i+1];
     myDataZ[i]:=myDataZ[i+1];
    end;
    myCount:=max(0,myCount-1);
   end;
   UnlockUpdate;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.GetText(const SectionName:ShortString):LongString;
var i,nx,ny,nw,nz:Integer; p:TText;
begin
 Result:='';
 if Assigned(Self) then
 try
  p:=NewText;
  Lock;
  try
   if IsEmptyStr(SectionName)
   then p.Addln(Format('[%s-%s calibration]',[NameX,NameY]))
   else p.Addln(Format('%s',[SectionName]));
   p.Addln(Format('FitMethod = %s',['Polynom']));
   p.Addln(Format('TransformX = %s',[TransformX]));
   p.Addln(Format('TransformY = %s',[TransformY]));
   p.Addln(Format('Power = %d',[Power]));
   p.Addln(Format('Center = %g',[Center]));
   p.Addln(Format('Scale = %g',[Scale]));
   p.Addln(Format('Fixed = %d',[Ord(IsFixed)]));
   if IsFixed or IsValid then for i:=0 to Power do p.Addln(Format('Coeff[%d] = %g',[i,Coeff[i]]));
   p.Addln(Format('Bounds = %g, %g',[BoundA,BoundB]));
   nx:=Length(NameX); ny:=Length(NameY);
   nw:=Length(NameW); nz:=Length(NameZ);
   for i:=0 to Count-1 do nx:=max(nx,Length(Format('%g',[Items[i].x])));
   for i:=0 to Count-1 do ny:=max(ny,Length(Format('%g',[Items[i].y])));
   for i:=0 to Count-1 do nw:=max(nw,Length(Format('%g',[Items[i].w])));
   for i:=0 to Count-1 do nz:=max(nz,Length(Format('%g',[Items[i].z])));
   if IsEmptyStr(NameZ)
   then p.Addln(Format('Data %-*s  %-*s  %-*s',       [nx,NameX, ny,NameY, nw,NameW]))
   else p.Addln(Format('Data %-*s  %-*s  %-*s  %-*s', [nx,NameX, ny,NameY, nw,NameW, nz,NameZ]));
   for i:=0 to Count-1 do with Items[i] do
   if IsEmptyStr(NameZ)
   then p.Addln(Format('     %-*g  %-*g  %-*g',       [nx,x, ny,y, nw,w]))
   else p.Addln(Format('     %-*g  %-*g  %-*g  %-*g', [nx,x, ny,y, nw,w, nz,z]));
   p.Addln('End Data');
   if Note.Count>0 then begin
    p.Addln('Notice Text');
    p.Concat(Note);
    p.Addln('End Notice Text');
   end;
   Result:=p.Text;
  finally
   Unlock;
   Kill(p);
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.SaveToFile(const aFileName    : ShortString;
                                        const aSectionName : ShortString='';
                                              IsAppend     : Boolean=false):Boolean;
var F:Text; IOR:Integer;
begin
 Result:=false;
 if Assigned(Self) then
 try
  IOR:=System.IOResult;
  System.Assign(F,aFileName);
  if FileExists(aFileName) and IsAppend then System.Append(F) else System.Rewrite(F);
  try
   System.Write(F,TextAddMetaData(GetText(aSectionName)));
   if System.IOResult=0 then begin
    FileName:=aFileName;
    Result:=true;
   end;
   if Result then SendToMainConsole('@silent @integrity save.cal '+FileName+CRLF);
  finally
   System.Close(F);
   System.SetInOutRes(IOR);
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TPolynomCalibration.LoadFromFile(const aFileName    : ShortString;
                                          const aSectionName : ShortString = ''):Boolean;
var
 P        : PChar;
 aSection : LongString;
 aPower   : LongInt;
 aCenter  : Double;
 aScale   : Double;
 aFixed   : LongInt;
 aCoeff   : Double;
 aBounds  : packed record A,B:Double; end;
 s        : ShortString;
 i        : Integer;
 ix       : Integer;
 iy       : Integer;
 iw       : Integer;
 iz       : Integer;
 DataRow  : TCalibPoint;
 Temp     : TPolynomCalibration;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Temp:=TPolynomCalibration.Create;
  Lock;
  try
   LockUpdate;
   aSection:='';
   Temp.Assign(Self);
   Clear;
   if IsEmptyStr(aSectionName)
   then aSection:=ExtractTextSection(aFileName,Format('[%s-%s calibration]',[NameX,NameY]),efConfig)
   else aSection:=ExtractTextSection(aFileName,Format('%s',[aSectionName]),efConfig);
   if Length(aSection)>0 then begin
    P:=PChar(aSection);
    if ScanVar(svConfig,P,'Bounds%f;%f',aBounds)<>nil then begin
     BoundA:=Min(aBounds.A,aBounds.B);
     BoundB:=Max(aBounds.A,aBounds.B);
    end;
    if ScanVar(svConfig,P,'Power%d',aPower)<>nil then Power:=aPower else Power:=1;
    if ScanVar(svConfig,P,'Center%f',aCenter)<>nil then Center:=aCenter else Center:=BoundA;
    if ScanVar(svConfig,P,'Scale%f',aScale)<>nil then Scale:=aScale else Scale:=(BoundB-BoundA);
    if ScanVar(svConfig,P,'TransformX%s',s)<>nil then TransformX:=s else TransformX:='Line';
    if ScanVar(svConfig,P,'TransformY%s',s)<>nil then TransformY:=s else TransformY:='Line';
    if ScanVar(svConfig,P,'Fixed%d',aFixed)<>nil then IsFixed:=(aFixed<>0) else IsFixed:=false;
    if IsFixed then for i:=0 to Power do
    if ScanVar(svConfig,P,'Coeff['+IntToStr(i)+']%f',aCoeff)<>nil then Coeff[i]:=aCoeff else Coeff[i]:=0;
    { Read Data section }
    ix:=0;
    iy:=0;
    iw:=0;
    iz:=0;
    s:='';
    P:=StrPass(ScanVar(svConfig,P,'Data%s',s),[CR,LF]);
    for i:=1 to WordCount(s,[' ',Tab]) do begin
     if SameText(ExtractWord(i,s,[' ',Tab]),NameX) then ix:=i;
     if SameText(ExtractWord(i,s,[' ',Tab]),NameY) then iy:=i;
     if SameText(ExtractWord(i,s,[' ',Tab]),NameW) then iw:=i;
     if SameText(ExtractWord(i,s,[' ',Tab]),NameZ) then iz:=i;
    end;
    if (ix>0) and (iy>0) then
    while Assigned(P) do begin
     P:=StrPass(ScanVar(svAsIs,P,'%s',s),[CR,LF]);
     if Assigned(P) then begin
      if Pos('END DATA',UpcaseStr(s))>0 then break;
      with DataRow do begin x:=0; y:=0; w:=1; z:=0; end;
      if (ix>0) and not Str2Real(ExtractWord(ix,s,[' ',Tab]),DataRow.x) then continue;
      if (iy>0) and not Str2Real(ExtractWord(iy,s,[' ',Tab]),DataRow.y) then continue;
      if (iw>0) and not Str2Real(ExtractWord(iw,s,[' ',Tab]),DataRow.w) then continue;
      if (iz>0) and not Str2Real(ExtractWord(iz,s,[' ',Tab]),DataRow.z) then continue;
      Insert(DataRow);
     end;
    end;
    if Count>0 then begin
     aSection:='';
     {чтение раздела Notice Text.. End Notice Text}
     if IsEmptyStr(aSectionName)
     then aSection:=ExtractTextSection(aFileName,Format('[%s-%s calibration]',[NameX,NameY]),efAsIs)
     else aSection:=ExtractTextSection(aFileName,Format('%s',[aSectionName]),efAsIs);
     P:=StrPass(ScanVar(svConfig,PChar(aSection),'Notice%a',s),[CR,LF]);
     if Assigned(P) and IsSameText(s,'Text') then
     while Assigned(P) do begin
      P:=StrPass(ScanVar(svAsIs,P,'%s',s),[CR,LF]);
      if Assigned(P) then begin
       if Pos('End Notice Text',s)>0 then break;
       Note.Addln(s);
      end;
     end;
     FileName:=aFileName;
     Result:=true;
    end;
   end;
   if not Result then Assign(Temp);
   if Result then SendToMainConsole('@silent @integrity load.cal '+FileName+CRLF);
   if Result then FileCheckMetaData(FileName,true);
   UnlockUpdate;
  finally
   Unlock;
   Kill(Temp);
   aSection:='';
  end;
 except
  on E:Exception do begin
   ErrorFound(E);
   Clear;
  end;
 end;
end;

function polynomcalib_inv(const y,z:Double; cal:TPolynomCalibration):Double;
var a,b,c,d,e,fa,fb,fc,eps,tol,tol1,xm,p,q,r,s,big,del,fac:Double;
 itn,met,mit:Integer; Terminate,Failure:Boolean;
 function FSign(a,b:Double):Double;
 begin
  if b<=0 then FSign:=-abs(a) else FSign:=abs(a);
 end;
 function Sign(x:Double):Integer;
 begin
  if x<0 then Sign:=-1 else if x>0 then Sign:=+1 else Sign:=0;
 end;
 function F(t:Double):Double;
 var goal:Double;
 begin
  goal:=cal.GetY(t,z)-y;
  if isNaN(goal) then Failure:=True;
  if isInf(goal) then Failure:=True;
  F:=goal;
 end;
begin
 c:=0; itn:=0;
 Failure:=False; Terminate:=False;
 met:=polynomcalib_met; if met<=0 then met:=1;     // zeroin method
 mit:=polynomcalib_mit; if mit<=0 then mit:=128;   // max.iteration
 eps:=polynomcalib_eps; if eps<=0 then eps:=1E-15; // mach. epsilon
 tol:=polynomcalib_tol; if tol<=0 then tol:=1E-14; // the tolerance
 big:=polynomcalib_big; if big<=0 then big:=1E+14; // big range
 del:=polynomcalib_del; if del<=0 then del:=0;     // delta
 fac:=polynomcalib_fac; if fac<=1 then fac:=1;     // factor
 if not Failure then begin
  a:=cal.BoundA; b:=cal.BoundB;
  a:=Min(a,cal.ItemsRange.a.x);
  b:=Max(b,cal.ItemsRange.b.x);
  if a>b then begin c:=a; a:=b; b:=c; end;
  fa:=F(a); fb:=F(b);
  if del>0 then begin // Use linear extrapolation outside (a,b)
   if fa<fb then begin
    if Sign(fa)>0 then begin c:=a-fa*del/(fa-F(a-del)); Terminate:=true; end else
    if Sign(fb)<0 then begin c:=b-fb*del/(F(b+del)-fb); Terminate:=true; end;
   end else
   if fa>fb then begin
    if Sign(fb)>0 then begin c:=b-fb*del/(F(b+del)-fb); Terminate:=true; end else
    if Sign(fa)<0 then begin c:=a-fa*del/(fa-F(a-del)); Terminate:=true; end;
   end;
  end else
  if Sign(fa)*Sign(fb)>0 then begin
   d:=b-a;
   if Sign(fa)*Sign(fb-fa)>0 then if fac<=1 then a:=-big else begin
    while (itn<mit) and (abs(a-d)<big) and not Failure do begin
     if Sign(F(a-d))*Sign(fb)<=0 then begin a:=a-d; itn:=mit; end;
     d:=d*2; itn:=itn+1;
    end;
   end;
   if Sign(fb)*Sign(fb-fa)<0 then if fac<=1 then b:=+big else begin
    while (itn<mit) and (abs(b+d)<big) and not Failure do begin
     if Sign(fa)*Sign(F(b+d))<=0 then begin b:=b+d; itn:=mit; end;
     d:=d*2; itn:=itn+1;
    end;
   end;
   itn:=0;
  end;
  if not Terminate then
  if met=1 then begin // Method: ZeroIn
   fa:=F(a);
   if fa=0.0 then c:=a else begin
    fb:=F(b);
    if fb=0.0 then c:=b else begin
     c:=a; fc:=fa; d:=b-a; e:=d;
     if Sign(fa)*Sign(fb)>0 then Failure:=True;
     while not Terminate and not Failure do begin
      if abs(fc)<abs(fb) then begin a:=b; b:=c; c:=a; fa:=fb; fb:=fc; fc:=fa; end;
      tol1:=2.0*eps*abs(b)+0.5*tol; xm:=0.5*(c-b);
      if (abs(xm)<=tol1) or (fb=0.0) or (itn>=mit) then Terminate:=True else begin
       if (abs(e)<tol1) or (abs(fa)<=abs(fb)) then begin
        d:=xm; e:=d;
       end else begin
        if a<>c then begin
         q:=fa/fc; r:=fb/fc; s:=fb/fa; p:=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0)); q:=(q-1.0)*(r-1.0)*(s-1.0);
        end else begin
         s:=fb/fa; p:=2.0*xm*s; q:=1.0-s;
        end;
        if p>0.0 then q:=-q; p:=abs(p);
        if (2.0*p>=3.0*xm*q-abs(tol1*q)) or (p>=abs(e*q*0.5)) then begin
         d:=xm; e:=d;
        end else begin
         e:=d; d:=p/q;
        end;
       end;
       a:=b; fa:=fb;
       if abs(d)> tol1 then b:=b+d else b:=b+FSign(tol1,xm);
       fb:=F(b); if fb*(fc/abs(fc))>0 then begin c:=a; fc:=fa; d:=b-a; e:=d; end;
      end;
      itn:=itn+1;
     end;
     c:=b;
    end;
   end;
  end else begin // Method: Bisection
   fa:=F(a);
   if fa=0.0 then c:=a else begin
    fb:=F(b);
    if fb=0.0 then c:=b else begin
     if Sign(fa)*Sign(fb)>0 then Failure:=True;
     while not Terminate and not Failure do begin
      c:=a+(b-a)*0.5; fc:=F(c);
      if (fc=0.0) then Terminate:=True else
      if (itn>=mit) then Terminate:=True else
      if (abs(b-a)<tol) then Terminate:=True else
      if Sign(fc)*Sign(fa)<0 then begin b:=c; fb:=fc; end else
      if Sign(fc)*Sign(fb)<0 then begin a:=c; fa:=fc; end else Failure:=True;
      itn:=itn+1;
     end;
    end;
   end;
  end;
 end;
 if Failure then c:=_NaN;
 polynomcalib_inv:=c;
end;

initialization

 DefaultCalibTransformItem:=CalibTransformItem(LineTransformer,'Line',_MinusInf,_PlusInf,0);

 CalibTransformList:=TCalibTransformList.Create;
 CalibTransformList.Master:=CalibTransformList;

 with CalibTransformList do begin
  Add(CalibTransformItem(LineTransformer, 'Line', _MinusInf, _PlusInf, 0.0));
  Add(CalibTransformItem(LineTransformer, id_CalibEvalAlias, _MinusInf, _PlusInf, 0.0));
  Add(CalibTransformItem(LgTransformer,   'Lg',    1.0E-100, _PlusInf, 10.0));
  Add(CalibTransformItem(SubZTransformer, 'SubZ', _MinusInf, _PlusInf, 0.0));
  Add(CalibTransformItem(AddZTransformer, 'AddZ', _MinusInf, _PlusInf, 0.0));
 end;
 InitRtdTcTransformers;

 polynomcalib_met:=1;          // zeroin method
 polynomcalib_mit:=128;        // max.iteration
 polynomcalib_eps:=MachEps*1;  // mach. epsilon
 polynomcalib_tol:=MachEps*10; // the tolerance
 polynomcalib_big:=1E+14;      // big range value
 polynomcalib_del:=0;          // line ext. delta
 polynomcalib_fac:=2;          // grow factor

finalization

 Kill(TObject(CalibTransformList));

 ResourceLeakageLog(Format('%-60s = %d',['Balance of TPolinomCalibration.LockUpdate/UnlockUpdate',LockUnlockBalance]));

end.
