{--------------------------------------------------------------------------- The control units for mass-spectrometer MI1201-AGM (c) Copyright Aleksandrov O.E., 2003 Модуль управления масс-спектрометром МИ1201-АГМ (c) Собственность Александрова О.Е., 2003 Molecular Physics department 620002, Екатеринбург, К-2 USTU, Ekaterinsburg, K-2, 620002 УГТУ, RUSSIA Кафедра молекулярной физики phone 75-41-46 тел. 75-41-46 E-mail: aleks@dpt.ustu.ru ----------------------------------------------------------------------------} { Определение аппроксимирующей функции (F) и ее частных производных (GradF) для подключения к процедуре обобщенного поиска минимума функции многих переменных (см. модуль uGenFit). ЭТА DLL служит примером оформления для подключаемых функций. Аппроксимирующая функция: F(x):=A*(erf(s*((x-x0)+h))-erf(s*((x-x0)-h)))+)+B Параметры и их порядок в структуре данных: P=(A, B, x0, h, s); } unit FunctionDefinition; interface USES GenFit_EFI_Declarations; const cFunctionName='Интеграл от функции Гаусса: F(A,B,x,h,s)=A*(Erf(s*(x+h))-Erf(s*(x-h)))+B'; cFunctionParametersCount=4; cNormalizeParametersCount=4; type { Определение явного списка параметров функции } tFuncParams=packed record Size:tParameterNumber; A,B,x0,h,s:tRealType; end; tPtrFuncParams=^tFuncParams; type tNormalizeParameter=packed record Origin, Scale:tRealType; end; tNormalizeParameters=packed record Size:tParameterNumber; X,Y:tNormalizeParameter; end; tPtrNormalizeParameters=^tNormalizeParameters; function F(const P:tStaticParameters; X:tRealType; var F:tRealType):boolean; register; function GradF(const P:tStaticParameters; X:Double; var Grad:tStaticParameters):boolean; register; function SelectInitials(var P:tStaticParameters; const X,Y:tStaticData):boolean; register; function NormalizeData(var ND:tStaticParameters; var aX,aY:tStaticData):boolean; register; function Normalize(const NP:tStaticParameters; aX,aY:tRealType; var NX,NY:tRealType):boolean; register; function UnNormalize(const NP:tStaticParameters; NX,NY:tRealType; var aX,aY:tRealType):boolean; register; implementation USES uErf; function F(const P:tStaticParameters; X:tRealType; var F:tRealType):boolean; register; begin try with tPtrFuncParams(@P)^ do begin If Size<>cFunctionParametersCount then begin SetLastError(Ord(ecInvalidParametersCount)); Result:=FALSE; Exit; end; x:=x-x0; F:=A*(Erf(s*(x+h))-Erf(s*(x-h)))+B; Result:=TRUE; end; except SetLastError(Ord(ecUnknownException)); Result:=FALSE; end; end; function GradF(const P:tStaticParameters; X:Double; var Grad:tStaticParameters):boolean; register; const c2divSqrtPI=2/1.7724538509055160273; { = 2/Sqrt(PI) } var x1,x2,sx1,sx2,expSx1,expSx2:Extended; A_2divSqrtPI,AS_2divSqrtPI:Extended; begin try with tPtrFuncParams(@P)^ do begin If Size<>cFunctionParametersCount then begin SetLastError(Ord(ecInvalidParametersCount)); Result:=FALSE; Exit; end; x:=x-x0; x1:=(x+h); x2:=(x-h); sx1:=s*x1; sx2:=s*x2; expSx1:=exp(-sx1*sx1); expSx2:=exp(-sx2*sx2); A_2divSqrtPI:=A*c2divSqrtPI; AS_2divSqrtPI:=S*A_2divSqrtPI; end; with tPtrFuncParams(@Grad)^ do begin A :=Erf(sx1)-Erf(sx2); { dF/dA } B :=1; { dF/dB } X0:=AS_2divSqrtPI*(-expSx1+expSx2); { dF/dX0 } H :=AS_2divSqrtPI*(expSx1+expSx2); { dF/dH } S :=A_2divSqrtPI*(x1*expSx1-x2*expSx2); { dF/dS } end; except SetLastError(Ord(ecUnknownException)); Result:=FALSE; end; Result:=TRUE; end; { Выбор начального приближения для параметров } function SelectInitials(var P:tStaticParameters; const X,Y:tStaticData):boolean; register; var dX,maxY,minY,minX,maxX,iX0:Double; i:word; begin with tPtrFuncParams(@P)^ do begin If Size<>cFunctionParametersCount then begin SetLastError(Ord(ecInvalidParametersCount)); Result:=FALSE; Exit; end; If (X.Size<>Y.Size) then begin SetLastError(Ord(ecDataSizeMismatch)); Result:=FALSE; Exit; end; If (X.Size<=Size+2) then begin SetLastError(Ord(ecTooFewDataValues)); Result:=FALSE; Exit; end; If (X.Size>cMaxDataSize) then begin SetLastError(Ord(ecTooManyDataValues)); Result:=FALSE; Exit; end; maxY:=Y.DataArray[1]; minY:=Y.DataArray[1]; minX:=X.DataArray[1]; maxX:=X.DataArray[1]; iX0:=minX; for i:=2 to X.Size do begin if maxYcNormalizeParametersCount then begin Result:=FALSE; SetLastError(Ord(ecInvalidParametersCount)); Exit; end; aX:=X.Origin+X.Scale*NX; aY:=Y.Origin+Y.Scale*NY; end; Result:=TRUE; except Result:=FALSE; SetLastError(Ord(ecUnknownException)); end; end; function Normalize(const NP:tStaticParameters; aX,aY:tRealType; var NX,NY:tRealType):boolean; register; begin try with tPtrNormalizeParameters(@NP)^ do begin {$IfOpt R+} if Size<>cNormalizeParametersCount then begin Result:=FALSE; SetLastError(Ord(ecInvalidParametersCount)); Exit; end; {$EndIf} NX:=(aX-X.Origin)/X.Scale; NY:=(aY-Y.Origin)/Y.Scale; end; Result:=TRUE; except Result:=FALSE; SetLastError(Ord(ecUnknownException)); end; end; function NormalizeVector(var NP:tNormalizeParameter; V:tStaticData):boolean; var min,max:Extended; i:cardinal; begin if V.Size<2*cFunctionParametersCount then begin SetLastError(Ord(ecTooFewDataValues)); Result:=FALSE; Exit; end; min:=V.DataArray[1]; max:=min; for i:=2 to V.Size do begin if maxcNormalizeParametersCount then begin SetLastError(Ord(ecInvalidParametersCount)); Result:=FALSE; Exit; end; Result:=NormalizeVector(X, aX); if Result then Result:=NormalizeVector(Y, aY); end; except SetLastError(Ord(ecUnknownException)); Result:=FALSE; end; end; end.