{---------------------------------------------------------------------------
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
----------------------------------------------------------------------------}
unit GenFit_EFI_Declarations;

{ Описание интерфейса для подключения внешних функций аппроксимации к General Fit Object из DLL.

Обобщенный поиск минимума функции многих переменных

Модуль включает универсальные определения некоторых вспомогательных функций
  function GetLastError:cardinal; register;
  function SetLastError(aErrorCode:cardinal):cardinal; register;
которые можно использовать, а можно переписать собственным вариантом.

И заглушки для всех функций, но заглушки ничего не делают только возвращают ошибку:

}


interface

{Текущая версия интерфейса подключения этого модуля }
function Version:cardinal; register;

const
  {Текущая версия интерфейса подключения, которую возвращает функция Version этого модуля }
  cVersion=1;

type
  tInfoParameter=(
    ipApproximatingFunctionsCount, // число апроксимирующих фукций, реализованных в DLL, нумерация с 0;
    ipApproximatingFriendlyFunctionName,   // понятное имя апроксимирующей фукции, реализованной в DLL, номер функции передается в aInfoBuffer;
    ipApproximatingFunctionInfo,  // адреса апроксимирующей фукции и градиента, число параметров, нормализующие функции и  т.д., см. тип данных tApproximatingFunctionInfo
    ipErrorMessage             // текстовое сообщение об ошибке;
  );

  tRealType=Double;

const
 { максимальный размер одномерного массива данных }
{$IfDef Seg16}
  cMaxDataSize=($FFFF-4*SizeOf(Word)) div SizeOf(tRealType);
{$Else}
  cMaxDataSize=(($FFFFFFFF div 2)-4*SizeOf(Word)) div SizeOf(tRealType);
{$EndIf Def Seg16}

 { максимальное число параметров функции }
  cMaxParameterSize=64;

type
  tParameterNumber=0..Pred(cMaxParameterSize);
  tParametersArray=packed array[tParameterNumber] of tRealType;
  tParametersSet=set of tParameterNumber;

  tDataNumber=0..Pred(cMaxDataSize);
  tDataArray=packed array[tDataNumber] of tRealType;

  { данные параметров }
  tStaticParameters=packed record
    Size:tParameterNumber; // число используемых ячеек в массиве Parameters
    Parameters:tParametersArray; // массив, содержащий не менеее Size элементов
  end;
  tPtrtStaticParameters=^tStaticParameters;

  { данные параметров - полная запись }
  tDynamicParameters=packed record
    Size:tParameterNumber; // ПОЛНОЕ число выделенных ячеек в массиве Data
    Data:tStaticParameters; // данные параметров для использования
  end;
  tPtrDynamicParameters=^tDynamicParameters;

  { данные для обработки }
  tStaticData=packed record
    Size:tDataNumber;      // число используемых ячеек в массиве DataArray
    DataArray:tDataArray;  // массив, содержащий не менеее Size элементов
  end;
  tPtrStaticData=^tStaticData;

  { данные для обработки - полная запись }
  tDynamicData=packed record
    Size:tDataNumber; // ПОЛНОЕ число выделенных ячеек в массиве Data
    Data:tStaticData;  // данные параметров для использования
  end;
  tPtrDynamicData=^tDynamicData;

  // коды ошибок
  tErrorCode=(ecOK,
              ecAbstractFunction, // функция не определена - используется заглушка
              ecUnknownError,   // неизвестная ошибка - для исключительных ситуаций при вызове чужих функций
	      ecMaxIterationNumberExeeded,
              ecInvalidParamrters,
              ecInvalidParametersCount,
              ecDataSizeMismatch,  // данные имеют разный размер
              ecTooFewDataValues,  // данные не могут быть обработаны - слишком мало данных
              ecTooManyDataValues,  // данные не могут быть обработаны - слишком много данных
              ecInvalidDataValues, // данные не могут быть обработаны - их значения не позволяют обработать
              ecInvalidDataValue,
              ecUnknownException,
              ecLastErrorCode
  // для ошибок, определяемых пользователем - используйте отрицательные коды
  );

  { Коды ошибок подключения DLL }
  tDllErrorCode=(
    ecDllOK,
    ecDllInvalid, // DLL не удовлетворяет описанию интерфейса - неверная DLL
    ecDllNoRequiredFunction // отсутствует обязательная функция

  );

{ Процедура возврата версии интерфейса подключения должна иметь такой заголовок.}
  tVersionFunction = function:cardinal; register;
{ Процедура возврата информации модуля иметь такой заголовок.}
  tInfoFunction = function (aParameter:tInfoParameter; var aInfoBuffer; aSize:cardinal):integer; register;

{ Процедура возврата кода последней ошибки. Имеет смысл только если любая из функций вернула FALSE,
отрицательные коды предназначены для ошибок определяемых пользователем }
  tGetLastErrorFunction = function:integer; register;
  tSetLastErrorFunction = function(aErrorCode:integer):integer; register;

{ Процедура вычисления значения аппроксимирующей функции должна
иметь такой заголовок. P - значения параметров и X - значение аргумента,
при которых вычисляется функция. }
  tAproximatingFunction  = function(const P:tStaticParameters; X:tRealType; var FuncResult:tRealType):boolean; register;

{ Процедура вычисления значений всех частных производных (градиента)
аппроксимирующей функции должна иметь такой заголовок.
Значения производных возвращаются в переменной GradF.
P - значения параметров и X - значение аргумента, при которых вычисляется
градиент. }
  tAproximatingFunctionGradient = function(const P:tStaticParameters; X:tRealType; var GradF:tStaticParameters):boolean; register;

{ Процедура нормализации набора данных X,Y, результаты нормализации, необходимые для преобразования
к нормализованному виду и обратно возвращаются в ND. Сами массивы могут быть переупорядочены с сохранением соответствия X->Y
должна иметь такой заголовок. Процедура может быть пустой - ничего не делать. }
  tNormalizeDataFunction  = function(var ND:tStaticParameters; var X,Y:tStaticData):boolean; register;
  tNormalizeFunction  = function(const NP:tStaticParameters; X,Y:tRealType; var NX,NY:tRealType):boolean; register;
  tUnNormalizeFunction  = function(const NP:tStaticParameters; NX,NY:tRealType; var X,Y:tRealType):boolean; register;

{ Процедура выбора начального приближения для значении параметров P
по данным X,Y - возврата версии интерфейса подключения должна иметь такой заголовок.}
  tSelectInitialsFunction = function (var P:tStaticParameters; const X,Y:tStaticData):boolean; register;

// Типы данных для буфера обмена функции Info.
// Буфер должен иметь размер равный максимальной величине из двух: размер Input или размер Output.
  tInfoBufferBufferType=(ibtInput, ibtOutput);

  tApproximatingFunctionsCount=packed record
    case tInfoBufferBufferType of
      ibtInput:();
      ibtOutput:(Count:cardinal);
  end;

  tApproximatingFriendlyFunctionName=packed record
    case tInfoBufferBufferType of
      ibtInput:(FunctionNumber:cardinal);
      ibtOutput:(
        Valid:boolean; // Valid=FALSE - функция с таким номером не определена
        NameSize:word;     // реальный размер буфера переменной длины
        Name:char          // буфер переменной длины
      );
  end;

  tFunctionInfo=packed record
    case Version:word of
    0:(
      ParametersCount:tParameterNumber;
      ApproximatingFunction:tAproximatingFunction;
      ApproximatingFunctionGradient:tAproximatingFunctionGradient;

      NormalizeUsed:boolean; // если NormalizeUSED=FALSE следующие четыре поля не используются
      NormalizeDataCount:tParameterNumber;
      NormalizeDataFunction:tNormalizeDataFunction;
      NormalizeFunction:tNormalizeFunction;
      UnNormalizeFunction:tUnNormalizeFunction;

      SelectInitialsFunction:tSelectInitialsFunction;
    );
  end;

  tApproximatingFunctionInfo=packed record
    case tInfoBufferBufferType of
      ibtInput:(FunctionNumber:cardinal);
      ibtOutput:(
        Valid:boolean; // Valid=FALSE - функция с таким номером не определена
        InfoSize:word;     // реальный размер буфера переменной длины
        Info:tFunctionInfo // буфер переменной длины
      );
  end;

  tErrorMessage=packed record
    case tInfoBufferBufferType of
      ibtInput:(ErrorCode:integer);
      ibtOutput:(
        Valid:boolean; // Valid=FALSE - ошибка с таким номером не определена
        MsgSize:word;     // реальный размер буфера переменной длины
        Msg:char          // буфер переменной длины
      );
  end;

const
  cFPMin=1.0e-300; { минимальное значение для арифметики плавающей точки (1.0e-30; - for Real)}
  cIterationMaxNumber=3000;     { максимальное количество итераций по-умолчанию }
  cCheckCnt=100; { проверка сходимости через указанное число циклов }

type
  tControlData=packed record
    FPMin:tRealType; { минимальное значение для арифметики плавающей точки }
    IterationMaxNumber:cardinal;     { максимальное количество итераций по-умолчанию }
    CheckCounterMax:cardinal; { проверка сходимости через указанное число циклов }
    CheckCounter:cardinal; { счетчик циклов }
  end;

  tNormalizeParameter=record
    Origin, Scale:Double;
  end;

  tNormalizeParameters=record
    x,y:tNormalizeParameter;
  end;

// ОБЯЗАТЕЛЬНЫЕ ФУНКЦИИ - определения см. выше

{Функция возврата информации об аппроксимирующих функциях
!!! Данная реализация только проверяет аргументы на допустимость.
аргументы:
  aParameter - код возвращаемой информации;
  aInfoBuffer - указатель на буфер, для возвращаемой информации и/или доп. параметров для aParameter;
  aSize - размер буфера aInfoBuffer;
возвращает:
 положительное число - размер в байтах информации в aInfoBuffer, если aInfoBuffer достаточно велик + запрошенная информация в aInfoBuffer;
 отрицательное число - размер в байтах, необходимый для возврата информации в aInfoBuffer, если размер aInfoBuffer недостаточен или aInfoBuffer=NIL;
 0 - если aParameter не поддерживается;
}
function Info(aParameter:tInfoParameter; var aInfoBuffer; aSize:cardinal):integer; register;

{ ФУНКЦИИ ОШИБОК. Это стандартный вариант для экспорта, можно заменить их своими вариантом.
Коды ошибок храняться в "per-thread" переменной. }
{ возврат кода последней ошибки.
  ВНИМАНИЕ! код ошибки актуален, ТОЛЬКО если
  функция DLL вернула FALSE, иначе возвращается предыдущий код ошибки.
  Все функции DLL НЕ ИЗМЕНЯЮТ LastError, если завершены успешно (хотя вы и можете модифицировать это поведение). }
function GetLastError:integer; register;
{ установка кода последней ошибки }
function SetLastError(aErrorCode:integer):integer; register;

{ ОСНОВНЫЕ ФУНКЦИИ ВЫЧИСЛЕНИЙ. Это ПУСТЫШКИ для экспорта, НУЖНО заменить их своими вариантом. }
{Пустышка вычисления значения аппроксимирующей функции  }
function AproximatingFunction(const P:tStaticParameters; X:tRealType; var FuncResult:tRealType):boolean; register;
{ Пустышка  вычисления значений всех частных производных (градиента) аппроксимирующей функции }
function AproximatingFunctionGradient(const P:tStaticParameters; X:tRealType; var GradF:tStaticParameters):boolean; register;
//----------------------------------------------

// НеОБЯЗАТЕЛЬНЫЕ ФУНКЦИИ - вспомогательные и информационные
{Пустышка нормализации данных }
function NormalizeData(var ND:tStaticParameters; var X,Y:tStaticData):boolean; register;
{Пустышки преобразования  данных }
function Normalize(const NP:tStaticParameters; X,Y:tRealType; var NX,NY:tRealType):boolean; register;
function UnNormalize(const NP:tStaticParameters; NX,NY:tRealType; var X,Y:tRealType):boolean; register;
//----------------------------------------------

implementation


{Текущая версия интерфейса подключения этого модуля }
function Version:cardinal; register;
begin
  Result:=cVersion;
end;

{Пустышка информации этого модуля }
function Info(aParameter:tInfoParameter; var aInfoBuffer; aSize:cardinal):integer; register;
begin
  Result:=0;
  case aParameter of
    // число апроксимирующих фукций, реализованных в DLL, нумерация с 0;
    ipApproximatingFunctionsCount: begin
      if aSize>=SizeOf(tApproximatingFunctionsCount) then begin
        Result:=aSize-SizeOf(tApproximatingFunctionsCount);
      end else begin
        Result:=aSize-SizeOf(tApproximatingFunctionsCount);
      end;
    end;

    // понятное имя апроксимирующей фукции, реализованной в DLL, номер функции передается в aInfoBuffer;
    ipApproximatingFriendlyFunctionName: begin
      if aSize>=SizeOf(tApproximatingFriendlyFunctionName) then begin
        Result:=aSize-SizeOf(tApproximatingFriendlyFunctionName);
      end else begin
        Result:=aSize-SizeOf(tApproximatingFriendlyFunctionName);
      end;
    end;
    
    // адреса апроксимирующей фукции и градиента, число параметров, нормализующие функции и  т.д., см. тип данных tApproximatingFunctionInfo
    ipApproximatingFunctionInfo: begin
    end;
    
    // текстовое сообщение об ошибке;
    ipErrorMessage: begin
    end;
  end;
end;

{Пустышка вычисления значения аппроксимирующей функции  }
function AproximatingFunction(const P:tStaticParameters; X:tRealType; var FuncResult:tRealType):boolean; register;
begin
  SetLastError(Ord(ecAbstractFunction));
  Result:=FALSE;
end;

{ Пустышка  вычисления значений всех частных производных (градиента) аппроксимирующей функции }
function AproximatingFunctionGradient(const P:tStaticParameters; X:tRealType; var GradF:tStaticParameters):boolean; register;
begin
  SetLastError(Ord(ecAbstractFunction));
  Result:=FALSE;
end;

{Пустышка нормализации данных }
function NormalizeData(var ND:tStaticParameters; var X,Y:tStaticData):boolean; register;
begin
  Result:=TRUE;
end;

{Пустышки преобразования  данных }
function Normalize(const NP:tStaticParameters; X,Y:tRealType; var NX,NY:tRealType):boolean; register;
begin
  NX:=X;
  NY:=Y;
  Result:=TRUE;
end;

function UnNormalize(const NP:tStaticParameters; NX,NY:tRealType; var X,Y:tRealType):boolean; register;
begin
  X:=NX;
  Y:=NY;
  Result:=TRUE;
end;

threadvar
  gtvLastErrorCode:integer;

{ возврат кода последней ошибки }
function GetLastError:integer; register;
begin
  Result:=gtvLastErrorCode;
end;

{ установка кода последней ошибки }
function SetLastError(aErrorCode:integer):integer; register;
begin
  Result:=gtvLastErrorCode;
  gtvLastErrorCode:=aErrorCode;
end;

end.