unit CorCoef;

interface

uses GLType,Mathobj,GLProc,Classes,SysUtils, MVTU_TLB;

type
 TCorState=record
  SumX,SumY,XX,YY,XY,REZ:TExtArray;
  N:double;
 end;
 PCorState=^TCorState;

   //Свойства коэффициента корреляции
 TCorProp=record
  Size:^integer;    //Размер серии
  OutMode:^integer; //1 - вывод по сериям ,0 - вывод по всей выборке
  Tau:^double;      //Период квантования
 end;
 PCorProp=^TCorProp;

  //Вычисление среднеквадратического отклонения
function TStatCorCoef(at,adt:RealType;var time,dtime:RealType;var AU,AY:TPtrExt;var AX,ADX:array of RealType;
  var CU,CY : TIntArray;var Prop:TPtrArray;var Vars:PCorState;Action:Integer):Integer;export;

function TStatCorCoefRst(at,adt:RealType;var AU,AY:TPtrExt;var AX,ADX:PExtArr;
 var Prop:TPtrArray;var Vars : PCorState;Action:Integer;var F:File):Integer;export;

implementation

function TStatCorCoefConvert(Action:  integer;
                          Vars:    Pointer;
                          Prop:    TPtrArray;
                          PropStr: TStringList;
                          BlockId: integer;
                          var MVTU: IMVTU_Server):integer;
  const RecName:PChar = 'Среднее арифметическое';
  var
      Res: integer;
begin
  case Action of
    //Возвращаем ссылку на имя записи в базе МВТУ-4
    cnv_GetRecName: Result:=integer(RecName);
    //Конвертируем и устанавливаем параметры при помощи интерфейса МВТУ
    cnv_Convert: with PCorProp(Prop.Arr)^ do try
                   //Присваиваем параметры для блока
                   MVTU.SetBlockProp(BlockId,'size',PChar(PropStr[0]),Res);
                   MVTU.SetBlockProp(BlockId,'outmode',PChar(IntToStr(OutMode^)),Res);
                   MVTU.SetBlockProp(BlockId,'tau',PChar(PropStr[2]),Res);
                 finally
                 end;
  end;
end;

function TStatCorCoef;
 var i:integer;
 label L0;
begin
 Result:=0;
 with Vars^,PCorProp(Prop.Arr)^ do
 case Action of
  f_GetConvertFuncAdr: Result:=integer(@TStatCorCoefConvert);
  f_GetCount   :  begin
   CY.arr^[0]:=CU.arr^[0];
   CU.arr^[1]:=CU.arr^[0]
   end;
  f_InitMem:  begin
   XX.ChangeCount(CU.arr^[0]);
   YY.ChangeCount(CU.arr^[0]);
   XY.ChangeCount(CU.arr^[0]);
   SumX.ChangeCount(CU.arr^[0]);
   SumY.ChangeCount(CU.arr^[0]);
   REZ.ChangeCount(CU.arr^[0]);
   end;
  f_InitState  :  begin
   N:=0;
   AY.Ptr(0).FillArray(0);
   XX.FillArray(0);
   YY.FillArray(0);
   XY.FillArray(0);
   SumX.FillArray(0);
   SumY.FillArray(0);
   goto L0;
   end;
  f_Create     :  begin
    Vars:=New(PCorState);
    with PCorState(Vars)^ do begin
     XX:=TExtArray.Create(1);
     YY:=TExtArray.Create(1);
     XY:=TExtArray.Create(1);
     SumX:=TExtArray.Create(1);
     SumY:=TExtArray.Create(1);
     REZ:=TExtArray.Create(1);
    end;
    end;
  f_Free       :  begin
   XX.Free;
   YY.Free;
   XY.Free;
   SumX.Free;
   SumY.Free;
   REZ.Free;
   Dispose(Vars);
   end;
  f_InitTime   :time:=at;
  f_RestoreOuts:Move(REZ.arr^,AY.Ptr(0).arr^,REZ.Count*SOfR);
  f_GoodStep   :if time-at<=adt/2 then begin
L0:N:=N+1;
   for i:=0 to AU.Ptr(0).Count-1 do begin
    SumX.arr^[i]:=SumX.arr^[i]+AU.Ptr(0).arr^[i];
    SumY.arr^[i]:=SumY.arr^[i]+AU.Ptr(1).arr^[i];
    XX.arr^[i]:=XX.arr^[i]+sqr(AU.Ptr(0).arr^[i]);
    YY.arr^[i]:=YY.arr^[i]+sqr(AU.Ptr(1).arr^[i]);
    XY.arr^[i]:=XY.arr^[i]+AU.Ptr(0).arr^[i]*AU.Ptr(1).arr^[i]
    end;
   if ((OutMode^<>1) or (N=Size^)) and (N>1) then begin
   for i:=0 to AU.Ptr(0).Count-1 do begin
     AY.Ptr(0).arr^[i]:=sqrt((XX.arr^[i]-sqr(SumX.arr^[i])/N)*(YY.arr^[i]-sqr(SumY.arr^[i])/N));
     if AY.Ptr(0).arr^[i]>0 then AY.Ptr(0).arr^[i]:=(XY.arr^[i]-SumX.arr^[i]*SumY.arr^[i]/N)/AY.Ptr(0).arr^[i] else AY.Ptr(0).arr[i]:=1;
    end;
   Move(AY.Ptr(0).arr^,REZ.arr^,REZ.Count*SOfR);
   end;
   if (N=Size^) and (OutMode^=1) then begin
    N:=0;
    SumX.FillArray(0);
    SumY.FillArray(0);
    XX.FillArray(0);
    YY.FillArray(0);
    XY.FillArray(0)
    end;
   time:=time+Tau^;
   end;
  end;
end;

function TStatCorCoefRst;
begin
 Result:=0;
 with PCorProp(Prop.arr)^,Vars^ do
 case Action of
 f_ReadRez   : try
                BlockRead(F,REZ.arr^,REZ.Count*SOfR);
               except
                Result:=er_ReadFile
               end;
 f_WriteRez  : try
                BlockWrite(F,REZ.arr^,REZ.Count*SOfR);
               except
                Result:=er_WriteFile
               end;
 f_ReadRst   : try
                BlockRead(F,N,SOfR);
                BlockRead(F,SumX.arr^,SumX.Count*SOfR);
                BlockRead(F,SumY.arr^,SumY.Count*SOfR);
                BlockRead(F,XX.arr^,XX.Count*SOfR);
                BlockRead(F,YY.arr^,YY.Count*SOfR);
                BlockRead(F,XY.arr^,XY.Count*SOfR);
                BlockRead(F,REZ.arr^,REZ.Count*SOfR);
               except
                Result:=er_ReadFile
               end;
 f_WriteRst  : try
                BlockWrite(F,N,SOfR);
                BlockWrite(F,SumX.arr^,SumX.Count*SOfR);
                BlockWrite(F,SumY.arr^,SumY.Count*SOfR);
                BlockWrite(F,XX.arr^,XX.Count*SOfR);
                BlockWrite(F,YY.arr^,YY.Count*SOfR);
                BlockWrite(F,XY.arr^,XY.Count*SOfR);
                BlockWrite(F,REZ.arr^,REZ.Count*SOfR);
               except
                Result:=er_WriteFile
               end;
 end
end;

end.