////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Calibration routines.                                                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 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                                            //
// 20230501 - Modified for FPC (A.K.)                                         //
// 20250129 - Use TAtomicCounter                                              //
////////////////////////////////////////////////////////////////////////////////

unit _crw_calib; // calibrations

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_fifo, _crw_str, _crw_fio, _crw_fpu, _crw_plut,
 _crw_dynar, _crw_lsqpoly, _crw_couple, _crw_rtdtc, _crw_zm, _crw_meta, _crw_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 : PureString;                { описатель функции                 }
  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 : LongString;
                            aRangA : Double;
                            aRangB : Double;
                            aParam : Double):TCalibTransformItem;

function FormatCalibTransformItem(const Item:TCalibTransformItem):LongString;

 {
 Список всех преобразований
 }
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:LongString):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:LongString):LongString;
function ExtractCalibAlias(const s:LongString):LongString;
function IsSameCalibAlias(const a,b:LongString):Boolean;

 {
 Калибровка
 }
type
 TPolynomCalibration = class(TLatch)
 private
  myLockUpdate : Integer;
  myIsValid    : Boolean;
  myIsFixed    : Boolean;
  myCount      : Integer;
  myDataX      : PDoubleArray;
  myDataY      : PDoubleArray;
  myDataW      : PDoubleArray;
  myDataZ      : PDoubleArray;
  myNameX      : LongString;
  myNameY      : LongString;
  myNameZ      : LongString;
  myTransformX : TCalibTransformItem;
  myTransformY : TCalibTransformItem;
  myEvaluator  : TExpressionEvaluator;
  myPoly       : TPolynom;
  myBoundA     : Double;
  myBoundB     : Double;
  myNote       : TText;
  myFileName   : LongString;
  function    GetIsValid:Boolean;
  function    GetIsFixed:Boolean;
  procedure   SetIsFixed(aFixed:Boolean);
  function    GetCapacity:Integer;
  function    GetCount:Integer;
  function    GetItems(i:Integer):TCalibPoint;
  function    GetNameX:LongString;
  procedure   SetNameX(const aName:LongString);
  function    GetNameY:LongString;
  procedure   SetNameY(const aName:LongString);
  function    GetNameZ:LongString;
  procedure   SetNameZ(const aName:LongString);
  function    GetNameW:LongString;
  function    GetTransformX:LongString;
  procedure   SetTransformX(const aDescr:LongString);
  function    GetTransformY:LongString;
  procedure   SetTransformY(const aDescr:LongString);
  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:LongString;
  procedure   SetFileName(const aName:LongString);
  procedure   DebugMessage(const Msg:LongString);
 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            : LongString  read GetNameX      write SetNameX;
  property    NameY            : LongString  read GetNameY      write SetNameY;
  property    NameZ            : LongString  read GetNameZ      write SetNameZ;
  property    NameW            : LongString  read GetNameW;
  property    TransformX       : LongString  read GetTransformX write SetTransformX;
  property    TransformY       : LongString  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         : LongString  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:LongString):LongString;
  function    SaveToFile(const aFileName    : LongString;
                         const aSectionName : LongString='';
                               IsAppend     : Boolean=false):Boolean;
  function    LoadFromFile(const aFileName    : LongString;
                           const aSectionName : LongString=''):Boolean;
 end;

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

function  NewCalibration(const aNameX  : LongString = 'X';
                         const aNameY  : LongString = 'Y';
                         const aNameZ  : LongString = '';
                         const aTranX  : LongString = 'Line';
                         const aTranY  : LongString = 'Line';
                               aPower  : Integer    = 1;
                               aCenter : Double     = 0;
                               aScale  : Double     = 1;
                               aBoundA : Double     = -1e4;
                               aBoundB : Double     = +1e4;
                         const aNote   : LongString = ''
                                     ) : TPolynomCalibration;
function  NewCalibrationLoadFromFile(aNameX       : LongString;
                                     aNameY       : LongString;
                                     aNameZ       : LongString;
                                     aFileName    : LongString;
                                     aSectionName : LongString
                                                      ) : TPolynomCalibration;
function  NewCalibrationSmartLoadFromFile(const aFileName:LongString):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 : TAtomicCounter = nil;

procedure InitCalCounters;
begin
 LockedInit(LockUnlockBalance);
end;

procedure FreeCalCounters;
begin
 LockedFree(LockUnlockBalance);
end;

 {
 *******************************************************************************
 Creation / Destruction
 *******************************************************************************
 }
function  NewCalibration(const aNameX  : LongString = 'X';
                         const aNameY  : LongString = 'Y';
                         const aNameZ  : LongString = '';
                         const aTranX  : LongString = 'Line';
                         const aTranY  : LongString = '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,nil,'NewCalibration');
   Kill(Result);
  end;
 end;
end;

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

function NewCalibrationSmartLoadFromFile(const aFileName:LongString):TPolynomCalibration;
var p:TText; i:Integer; nx,ny,nz,FName:LongString;
begin
 Result:=nil;
 FName:=UnifyFileAlias(aFileName);
 if FileExists(FName) then
 try
  nx:='';
  ny:='';
  nz:='';
  p:=NewText;
  p.ReadFile(FName);
  for i:=0 to p.Count-1 do // Find: Data nx ny Weight nz
  if IsSameText(ExtractWord(1,p[i],ScanSpaces),'DATA') and
     IsSameText(ExtractWord(4,p[i],ScanSpaces),'WEIGHT')
  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,FName,'');
 except
  on E:Exception do BugReport(E,nil,'NewCalibrationSmartLoadFromFile');
 end;
end;

procedure Kill(var TheObject:TPolynomCalibration); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 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 : LongString;
                            aRangA : Double;
                            aRangB : Double;
                            aParam : Double):TCalibTransformItem;
begin
 SafeFillChar(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):LongString;
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:LongString):LongString;
begin
 if n>1
 then Result:=ExtractWord(n,s,[':'])
 else Result:=ExtractWord(n,s,[':',#0..' ']);
end;

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

function IsSameCalibAlias(const a,b:LongString):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:LongString):Boolean;
var w1,w2,w3,w4,w5:LongString; 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;
  StrPLCopy(Item.EvalF,w2,SizeOf(Item.EvalF)-1);
  StrPLCopy(Item.EvalI,w3,SizeOf(Item.EvalI)-1);
  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 (i>=0) and (i<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 IsNonEmptyStr(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:LongString):TCalibTransformItem;
var i:Integer;
begin
 Result:=DefaultCalibTransformItem;
 if Ok and IsNonEmptyStr(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,'GetIsValid');
 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,'GetIsFixed');
 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,'SetIsFixed');
 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,'GetCapacity');
 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,'GetCount');
 end;
end;

function TPolynomCalibration.GetItems(i:Integer):TCalibPoint;
begin
 Result:=CalibPoint(0,0,1,0);
 if Assigned(Self) then
 try
  Lock;
  try
   if (i>=0) and (i<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,'GetItems');
 end;
end;

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

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

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

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

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

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

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

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

procedure TPolynomCalibration.SetTransformX(const aDescr:LongString);
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,'SetTransformX');
 end;
end;

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

procedure TPolynomCalibration.SetTransformY(const aDescr:LongString);
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,'SetTransformY');
 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,'GetTransformRange');
 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,'GetEvaluator');
 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,'GetPower');
 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,'SetPower');
 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,'GetCenter');
 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,'SetCenter');
 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,'GetScale');
 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,'SetScale');
 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,'GetCoeff');
 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,'SetCoeff');
 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,'GetBoundA');
 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,'SetBoundA');
 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,'GetBoundB');
 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,'SetBoundB');
 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,'GetItemsRange');
 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,'GetNote');
 end;
end;

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

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

procedure TPolynomCalibration.DebugMessage(const Msg:LongString);
var s:LongString;
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,'DebugMessage');
 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));
  myNameX:='';
  myNameY:='';
  myNameZ:='';
  TransformX:='Line';
  TransformY:='Line';
  Kill(myEvaluator);
  Kill(myPoly);
  BoundA:=0;
  BoundB:=1;
  Kill(myNote);
  myFileName:='';
 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,'Assign');
 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,'Clear');
 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,'LinearX');
 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,'LinearY');
 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,'GetY');
 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,'GetX');
 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,'LockUpdate');
 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,'UnlockUpdate');
 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,'Update');
   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,'Insert');
 end;
end;

procedure TPolynomCalibration.Delete(index:Integer);
var i:Integer;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   LockUpdate;
   if (index>=0) and (index<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,'Delete');
 end;
end;

function TPolynomCalibration.GetText(const SectionName:LongString):LongString;
var i,nx,ny,nw,nz:Integer; p:TText;
const pr=16; // Precision digits
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',[pr,Items[i].x])));
   for i:=0 to Count-1 do ny:=max(ny,Length(Format('%.*g',[pr,Items[i].y])));
   for i:=0 to Count-1 do nw:=max(nw,Length(Format('%.*g',[pr,Items[i].w])));
   for i:=0 to Count-1 do nz:=max(nz,Length(Format('%.*g',[pr,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,pr,x, ny,pr,y, nw,pr,w]))
   else p.Addln(Format('     %-*.*g  %-*.*g  %-*.*g  %-*.*g', [nx,pr,x, ny,pr,y, nw,pr,w, nz,pr,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,'GetText');
 end;
end;

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

function TPolynomCalibration.LoadFromFile(const aFileName    : LongString;
                                          const aSectionName : LongString = ''):Boolean;
var
 P        : PChar;
 FName    : LongString;
 aSection : LongString;
 aPower   : LongInt;
 aCenter  : Double;
 aScale   : Double;
 aFixed   : LongInt;
 aCoeff   : Double;
 aBounds  : packed record A,B:Double; end;
 s        : LongString;
 i        : Integer;
 ix       : Integer;
 iy       : Integer;
 iw       : Integer;
 iz       : Integer;
 DataRow  : TCalibPoint;
 Temp     : TPolynomCalibration;
begin
 Result:=false;
 if Assigned(Self) then
 try
  FName:=UnifyFileAlias(aFileName,ua_FileDefLow);
  Temp:=TPolynomCalibration.Create;
  Lock;
  try
   LockUpdate;
   aSection:='';
   Temp.Assign(Self);
   Clear;
   if IsEmptyStr(aSectionName)
   then aSection:=ExtractTextSection(FName,Format('[%s-%s calibration]',[NameX,NameY]),efConfig)
   else aSection:=ExtractTextSection(FName,Format('%s',[aSectionName]),efConfig);
   if Length(aSection)>0 then begin
    P:=PChar(aSection);
    aBounds.A:=0; aBounds.B:=0;
    if ScanVarRecord(svConfig,P,'Bounds%f;%f',aBounds)<>nil then begin
     BoundA:=Min(aBounds.A,aBounds.B);
     BoundB:=Max(aBounds.A,aBounds.B);
    end;
    aPower:=0; aCenter:=0; aScale:=0; s:=''; aFixed:=0; aCoeff:=0;
    if ScanVarLongInt(svConfig,P,'Power%d',aPower)<>nil then Power:=aPower else Power:=1;
    if ScanVarDouble(svConfig,P,'Center%f',aCenter)<>nil then Center:=aCenter else Center:=BoundA;
    if ScanVarDouble(svConfig,P,'Scale%f',aScale)<>nil then Scale:=aScale else Scale:=(BoundB-BoundA);
    if ScanVarString(svConfig,P,'TransformX%s',s)<>nil then TransformX:=Trim(s) else TransformX:='Line';
    if ScanVarString(svConfig,P,'TransformY%s',s)<>nil then TransformY:=Trim(s) else TransformY:='Line';
    if ScanVarLongInt(svConfig,P,'Fixed%d',aFixed)<>nil then IsFixed:=(aFixed<>0) else IsFixed:=false;
    if IsFixed then for i:=0 to Power do
    if ScanVarDouble(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(ScanVarString(svConfig,P,'Data%s',s),[ASCII_CR,ASCII_LF]);
    for i:=1 to WordCount(s,[' ',ASCII_TAB]) do begin
     if SameText(ExtractWord(i,s,[' ',ASCII_TAB]),NameX) then ix:=i;
     if SameText(ExtractWord(i,s,[' ',ASCII_TAB]),NameY) then iy:=i;
     if SameText(ExtractWord(i,s,[' ',ASCII_TAB]),NameW) then iw:=i;
     if SameText(ExtractWord(i,s,[' ',ASCII_TAB]),NameZ) then iz:=i;
    end;
    if (ix>0) and (iy>0) then
    while Assigned(P) do begin
     P:=StrPass(ScanVarString(svAsIs,P,'%s',s),[ASCII_CR,ASCII_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,[' ',ASCII_Tab]),DataRow.x) then continue;
      if (iy>0) and not Str2Real(ExtractWord(iy,s,[' ',ASCII_Tab]),DataRow.y) then continue;
      if (iw>0) and not Str2Real(ExtractWord(iw,s,[' ',ASCII_Tab]),DataRow.w) then continue;
      if (iz>0) and not Str2Real(ExtractWord(iz,s,[' ',ASCII_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(FName,Format('[%s-%s calibration]',[NameX,NameY]),efAsIs)
     else aSection:=ExtractTextSection(FName,Format('%s',[aSectionName]),efAsIs);
     P:=StrPass(ScanVarAlpha(svConfig,PChar(aSection),'Notice%a',s),[ASCII_CR,ASCII_LF]);
     if Assigned(P) and IsSameText(s,'Text') then
     while Assigned(P) do begin
      P:=StrPass(ScanVarString(svAsIs,P,'%s',s),[ASCII_CR,ASCII_LF]);
      if Assigned(P) then begin
       if Pos('End Notice Text',s)>0 then break;
       Note.Addln(s);
      end;
     end;
     FileName:=FName;
     Result:=true;
    end;
   end;
   if not Result then Assign(Temp);
   if Result then SendToMainConsole('@silent @integrity load.cal '+FileName+EOL);
   if Result then FileCheckMetaData(FileName,true);
   UnlockUpdate;
  finally
   Unlock;
   Kill(Temp);
   aSection:='';
  end;
 except
  on E:Exception do begin
   ErrorFound(E,'LoadFromFile');
   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;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_calib;
begin
 InitCalCounters;
 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
end;

procedure Free_crw_calib;
begin
 Kill(TObject(CalibTransformList));
 ResourceLeakageLog(Format('%-60s = %d',['Balance of TPolinomCalibration.LockUpdate/UnlockUpdate',LockedGet(LockUnlockBalance)]));
 FreeCalCounters;
end;

initialization

 Init_crw_calib;

finalization

 Free_crw_calib;

end.

//////////////
// END OF FILE
//////////////

