unit Skew; interface uses GLType,Mathobj,GLProc,math,Classes,SysUtils, MVTU_TLB; type //Свойства коэффициента эксцесса TSkewProp=record Size:^integer; //Размер серии OutMode:^integer; //1 - вывод по сериям ,0 - вывод по всей выборке Tau:^double; //Период квантования DelTrend:^integer;//Удаление линейного тренда 0-не удалять тренд, 1-удалять тренд end; TSkewState=record Sum,SumSqr,SumCube,REZ,CNY,M:TExtArray; N,CN2:double; end; PSkewState=^TSkewState; PSkewProp=^TSkewProp; function TStatSkew(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:PSkewState;Action:Integer):Integer;export; function TStatSkewRst(at,adt:RealType;var AU,AY:TPtrExt;var AX,ADX:PExtArr; var Prop:TPtrArray;var Vars : PSkewState;Action:Integer;var F:File):Integer;export; implementation function TStatSkewConvert(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 PSkewProp(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); MVTU.SetBlockProp(BlockId,'deltrend',PChar(IntToStr(DelTrend^)),Res); finally end; end; end; function TStatSkew; var i:integer; tmp,a,b:double; label L0; begin Result:=0; with Vars^,PSkewProp(Prop.Arr)^ do case Action of f_GetConvertFuncAdr: Result:=integer(@TStatSkewConvert); f_GetCount : CY.arr^[0]:=CU.arr^[0]; f_InitMem: begin Sum.ChangeCount(CU.arr^[0]); SumSqr.ChangeCount(CU.arr^[0]); SumCube.ChangeCount(CU.arr^[0]); CNY.ChangeCount(CU.arr^[0]); M.ChangeCount(CU.arr^[0]); REZ.ChangeCount(CU.arr^[0]); end; f_InitState : begin N:=0; CN2:=0; CNY.FillArray(0); M.FillArray(0); AY.Ptr(0).FillArray(0); Sum.FillArray(0); SumSqr.FillArray(0); SumCube.FillArray(0); goto L0; end; f_Create : begin Vars:=New(PSkewState); with PSkewState(Vars)^ do begin Sum:=TExtArray.Create(1); SumSqr:=TExtArray.Create(1); SumCube:=TExtArray.Create(1); CNY:=TExtArray.Create(1); M:=TExtArray.Create(1); REZ:=TExtArray.Create(1); end end; f_Free : begin Sum.Free; SumSqr.Free; SumCube.Free; CNY.Free; M.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; CN2:=CN2+N*N; for i:=0 to AU.Ptr(0).Count-1 do begin CNY.arr^[i]:=CNY.arr^[i]+N*AU.Ptr(0).arr^[i]; M.arr^[i]:=M.arr^[i]+AU.Ptr(0).arr^[i]; b:=(CNY.arr^[i]-0.5*M.arr^[i]*N)/(CN2-N*sqr(0.5*N)); a:=M.arr^[i]/N-b*0.5*N; tmp:=AU.Ptr(0).arr^[i]-DelTrend^*(b*N+a); Sum.arr^[i]:=Sum.arr^[i]+tmp; SumSqr.arr^[i]:=SumSqr.arr^[i]+tmp*tmp; SumCube.arr^[i]:=SumCube.arr^[i]+tmp*tmp*tmp; end; if ((OutMode^<>1) or (N=Size^)) and (N>1) then begin for i:=0 to AU.Ptr(0).Count-1 do begin tmp:=(SumSqr.arr^[i]-sqr(Sum.arr^[i])/N)/(N-1); if tmp<>0 then AY.Ptr(0).arr^[i]:=((SumCube.arr^[i]*N-3*Sum.arr^[i]*SumSqr.arr^[i])*N+2*IntPower(Sum.arr^[i],3))/IntPower(N*sqrt(tmp),3) else AY.Ptr(0).arr^[i]:=0; end; Move(AY.Ptr(0).arr^,REZ.arr^,REZ.Count*SOfR); end; if (N=Size^) and (OutMode^=1) then begin N:=0; Sum.FillArray(0); SumSqr.FillArray(0); SumCube.FillArray(0); end; time:=time+Tau^; end; end; end; function TStatSkewRst; begin Result:=0; with PSkewProp(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,CN2,SOfR); BlockRead(F,Sum.arr^,Sum.Count*SOfR); BlockRead(F,SumSqr.arr^,SumSqr.Count*SOfR); BlockRead(F,SumCube.arr^,SumCube.Count*SOfR); BlockRead(F,REZ.arr^,REZ.Count*SOfR); BlockRead(F,M.arr^,M.Count*SOfR); BlockRead(F,CNY.arr^,CNY.Count*SOfR); except Result:=er_ReadFile end; f_WriteRst : try BlockWrite(F,N,SOfR); BlockWrite(F,CN2,SOfR); BlockWrite(F,Sum.arr^,Sum.Count*SOfR); BlockWrite(F,SumSqr.arr^,SumSqr.Count*SOfR); BlockWrite(F,SumCube.arr^,SumCube.Count*SOfR); BlockWrite(F,REZ.arr^,REZ.Count*SOfR); BlockWrite(F,M.arr^,M.Count*SOfR); BlockWrite(F,CNY.arr^,CNY.Count*SOfR); except Result:=er_WriteFile end; end end; end.