Фильтрация, регрессия, работа с массивом и серией

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Фильтрация, регрессия, работа с массивом и серией

 

Модуль предназначен для выполнения процедур:

- фильтрации

- регрессии

- операций с массивами

- операций с сериями

 

Зависимости: Math, TeEngine, Graphics, SysUtils, Dialogs

Автор:       lookin, lookin@mail.ru, Екатеринбург

Copyright:   lookin

Дата:        30 апреля 2002 г.

********************************************** }

 

unit FilterRegressionArraySeries;

 

interface

 

uses Math, TeEngine, Graphics, SysUtils, Dialogs;

 

type TIntegerArray = array of integer;

type TExIntegerArray = array of TIntegerArray;

type TDoubleArray = array of double;

type TExDoubleArray = array of TDoubleArray;

type TStringArray = array of string;

type TExStringArray = array of TStringArray;

 

procedure ArrayExpanding(var ValueArray: TDoubleArray; ExpandCoef: integer);

procedure ArrayLengthening(var ValueArray: TDoubleArray; SplitValue: integer);

procedure ArrayShortening(var ValueArray: TDoubleArray; SplitValue: integer);

procedure CubicSplineSmoothing(var ValueArray: TDoubleArray; Dsc: double;

                                Coef: integer);

procedure SevenPointNonLinearSmoothing(var ValueArray: TDoubleArray;

                                        Dsc: double; Coef: integer);

procedure FourierAnalysis(var ValueArray: TDoubleArray; NumGarmonics: integer);

procedure DoArraySmoothing(var ValueArray: TDoubleArray; FilterType: integer;

                            Dsc: double; SplitCoef, ExpandCoef: integer;

                            CycledFilter: boolean);

 

procedure LinearRegression(ValueArray,ArgumentArray: TDoubleArray;

                            SourceSeries,DestSeries: TChartSeries;

                            var MainCoef,FreeCoef: double; SeriesColor: TColor;

                            var Hint: string);

procedure HyperbolicRegression(ValueArray,ArgumentArray: TDoubleArray;

                                SourceSeries,DestSeries: TChartSeries;

                                var MainCoef,FreeCoef: double;

                                SeriesColor: TColor; var Hint: string);

procedure PowerRegression(ValueArray,ArgumentArray: TDoubleArray;

                           SourceSeries,DestSeries: TChartSeries;

                           var MainCoef,FreeCoef: double; SeriesColor: TColor;

                           var Hint: string);

procedure PolynomialRegression(ValueArray,ArgumentArray: TDoubleArray;

                                SourceSeries,DestSeries: TChartSeries;

                                PolyDegree: integer; var ArrayCoefs: TDoubleArray;

                                SeriesColor: TColor; var Hint: string);

procedure ExponentRegression(ValueArray,ArgumentArray: TDoubleArray;

                              SourceSeries,DestSeries: TChartSeries;

                              var MainCoef,FreeCoef: double; SeriesColor: TColor;

                              var Hint: string; Warning: boolean);

procedure ExponentialRegression(ValueArray,ArgumentArray: TDoubleArray;

                                 SourceSeries,DestSeries: TChartSeries;

                                 var MainCoef,FreeCoef: double; SeriesColor: TColor;

                                 var Hint: string; Warning: boolean);

procedure ExpPowerRegression(ValueArray,ArgumentArray: TDoubleArray;

                              SourceSeries,DestSeries: TChartSeries;

                              var MainCoef,FreeCoef: double; SeriesColor: TColor;

                              var Hint: string; Warning: boolean);

 

procedure CheckArrayBounds(var CArray: TDoubleArray; var FromPoint,ToPoint: integer);

procedure CheckSeriesBounds(CSeries: TChartSeries; var FromPoint,ToPoint: integer);

procedure ArrayFromArray(var SourceArray,DestArray: TDoubleArray;

                          FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

procedure ArrayFromSeries(var ValueArray: TDoubleArray; DataSeries: TChartSeries;

                           FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

procedure SeriesFromArray(var ValueArray: TDoubleArray; DataSeries: TChartSeries;

                           FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

function DerivFromArray(var SourceArray: TDoubleArray; FromPoint,ToPoint,

                         Discrete: integer; Extremum: string;

                         var Position: integer): double;

function DerivFromSeries(DataSeries: TChartSeries; FromPoint,ToPoint,

                          Discrete: integer; Extremum: string;

                          var Position: integer): double;

function ValueFromSeries(DataSeries: TChartSeries; FromPoint,ToPoint: integer;

                          Extremum: string; var Position: integer): double;

function ValueFromArray(var SourceArray: TDoubleArray; FromPoint,ToPoint: integer;

                         Extremum: string; var Position: integer): double;

function CalculateAreaOfArray(var SourceArray: TDoubleArray;

                               FromPoint,ToPoint,Method: integer;

                               BindToZero: boolean): double;

function CalculateAreaOfSeries(DataSeries: TChartSeries; FromPoint,ToPoint,

                                Method: integer; BindToZero: boolean): double;

procedure LinearTrendExclusion(var ValueArray: TDoubleArray);

 

procedure ColorizeSeries(DataSeries: TChartSeries; NewColor: TColor);

procedure SetXInterval(DataSeries: TChartSeries; XInterval: double);

procedure SetSeriesAxis(DataSeries: TChartSeries; NewAxis: TVertAxis);

 

var rv,rsmooth,smootha: TDoubleArray;

 

implementation

 

//Нелинейный фильтр по 7 точкам

procedure SevenPointNonLinearSmoothing(var ValueArray: TDoubleArray;

         Dsc: double; Coef: integer);

var j,k,i: integer;

   resv: array of array of double;

begin

if (Coef=0) or (Coef=1) then Exit;

SetLength(resv,Coef,(Length(ValueArray) div Coef));

for j:=0 to Coef-1 do for i:=0 to Length(resv[0])-1 do

resv[j][i]:=ValueArray[i*Coef+j];

for k:=0 to Coef-1 do for j:=0 to Length(resv[0])-1 do begin

if j=0 then resv[k][j]:=(39*ValueArray[j*Coef+k]+

8*ValueArray[(j+1)*Coef+k]-4*(ValueArray[(j+2)*Coef+k]+

ValueArray[(j+3)*Coef+k]-ValueArray[(j+4)*Coef+k])+

ValueArray[(j+5)*Coef+k]-2*ValueArray[(j+6)*Coef+k])/42;

if j=1 then resv[k][j]:=(8*ValueArray[j*Coef+k]+

19*ValueArray[(j+1)*Coef+k]+16*ValueArray[(j+2)*Coef+k]+

6*ValueArray[(j+3)*Coef+k]-4*ValueArray[(j+4)*Coef+k]-

7*ValueArray[(j+5)*Coef+k]+4*ValueArray[(j+6)*Coef+k])/42;

if j=2 then resv[k][j]:=(-4*ValueArray[j*Coef+k]+

16*ValueArray[(j+1)*Coef+k]+19*ValueArray[(j+2)*Coef+k]+

12*ValueArray[(j+3)*Coef+k]+2*ValueArray[(j+4)*Coef+k]-

4*ValueArray[(j+5)*Coef+k]+ValueArray[(j+6)*Coef+k])/42;

if (j>2) and (j<Length(resv[0])-3) then resv[k][j]:=

(7*ValueArray[j*Coef+k]+6*(ValueArray[(j-1)*Coef+k]+

ValueArray[(j+1)*Coef+k])+3*(ValueArray[(j-2)*Coef+k]+

ValueArray[(j+2)*Coef+k])-2*(ValueArray[(j-3)*Coef+k]+

ValueArray[(j+3)*Coef+k]))/21;

if j=Length(resv[0])-3 then resv[k][j]:=(-4*ValueArray[j*Coef+k]+

16*ValueArray[(j-1)*Coef+k]+19*ValueArray[(j-2)*Coef+k]+

12*ValueArray[(j-3)*Coef+k]+2*ValueArray[(j-4)*Coef+k]-

4*ValueArray[(j-5)*Coef+k]+ValueArray[(j-6)*Coef+k])/42;

if j=Length(resv[0])-2 then resv[k][j]:=(8*ValueArray[j*Coef+k]+

19*ValueArray[(j-1)*Coef+k]+16*ValueArray[(j-2)*Coef+k]+

6*ValueArray[(j-3)*Coef+k]-4*ValueArray[(j-4)*Coef+k]-

7*ValueArray[(j-5)*Coef+k]+4*ValueArray[(j-6)*Coef+k])/42;

if j=Length(resv[0])-1 then resv[k][j]:=(39*ValueArray[j*Coef+k]+

8*ValueArray[(j-1)*Coef+k]-4*ValueArray[(j-2)*Coef+k]-

4*ValueArray[(j-3)*Coef+k]-4*ValueArray[(j-4)*Coef+k]+

ValueArray[(j-5)*Coef+k]-2*ValueArray[(j-6)*Coef+k])/42; end;

for j:=Coef to Length(resv[0])-Coef do

for k:=0 to Coef-1 do ValueArray[j*Coef+k]:=resv[k][j];

end;

 

//Фильтр с кубическими сплайнами

procedure CubicSplineSmoothing(var ValueArray: TDoubleArray; Dsc: double;

         Coef: integer);

var j,k,i,N: integer;

   vresv,resv: array of array of double;

   maxv: array of double;

   av,h,mi,mj,v1,v2: double;

begin

if (Coef=0) or (Coef=1) then Exit;

N:=Length(ValueArray); SetLength(resv,Coef,N); h:=Coef*Dsc;

for k:=0 to Coef-1 do for j:=0 to (N div Coef)-2 do begin

if j=0 then begin mi:=(4*ValueArray[(j+1)*Coef+k]-

ValueArray[(j+2)*Coef+k]-3*ValueArray[j*Coef+k])/2;

mj:=(ValueArray[(j+2)*Coef+k]-ValueArray[j*Coef+k])/2; end;

if j=(N div Coef)-2 then begin

mi:=(ValueArray[(j+1)*Coef+k]-ValueArray[(j-1)*Coef+k])/2;

mj:=(3*ValueArray[(j+1)*Coef+k]+ValueArray[(j-1)*Coef+k]-

4*ValueArray[j*Coef+k])/2; end;

if (j>0) and (j<((N div Coef)-2)) then begin

mi:=(ValueArray[(j+1)*Coef+k]-ValueArray[(j-1)*Coef+k])/2;

mj:=(ValueArray[(j+2)*Coef+k]-ValueArray[j*Coef+k])/2; end;

for i:=j*Coef to (j+1)*Coef do begin

v1:=((j+1)*Coef+k)*Dsc-(i+k)*Dsc;

v2:=(i+k)*Dsc-(j*Coef+k)*Dsc;

resv[k][i+k]:=(Sqr(v1)*(2*v2+h)*ValueArray[j*Coef+k]+

Sqr(v2)*(2*v1+h)*ValueArray[(j+1)*Coef+k]+

(Sqr(v1)*v2*mi+Sqr(v2)*(-v1)*mj)/2)/h/h/h; end; end;

for j:=Coef to N-1-Coef do begin av:=0;

for k:=0 to Coef-1 do av:=av+resv[k][j]; av:=av/Coef; ValueArray[j]:=av; end;

end;

 

//Гармонический синтез Фурье

procedure FourierAnalysis(var ValueArray: TDoubleArray; NumGarmonics: integer);

var i,j,N: integer;

   yn,ap,bp: double;

   AFCoef,BFCoef: TDoubleArray;

begin

N:=Length(ValueArray); SetLength(AFCoef,NumGarmonics);

SetLength(BFCoef,NumGarmonics); AFCoef[0]:=Sum(ValueArray)/N; BFCoef[0]:=0;

for i:=1 to NumGarmonics-1 do begin AFCoef[i]:=0; BFCoef[i]:=0;

for j:=0 to N-1 do begin

AFCoef[i]:=AFCoef[i]+ValueArray[j]*cos(Pi*i*j*2/N);

BFCoef[i]:=BFCoef[i]+ValueArray[j]*sin(Pi*i*j*2/N); end;

AFCoef[i]:=AFCoef[i]*2/N; BFCoef[i]:=BFCoef[i]*2/N; end;

for j:=0 to N-1 do begin yn:=0; ap:=0; bp:=0;

for i:=1 to NumGarmonics-1 do begin

ap:=ap+AFCoef[i]*cos(2*Pi*i*(j/N)); bp:=bp+BFCoef[i]*sin(2*Pi*i*(j/N)); end;

yn:=AFCoef[0]+ap+bp; ValueArray[j]:=yn; end;

end;

 

//Общая процедура вызова нужного фильтра

procedure DoArraySmoothing(var ValueArray: TDoubleArray; FilterType: integer;

         Dsc: double; SplitCoef, ExpandCoef: integer; CycledFilter: boolean);

var j: integer;

begin

smoothA:=nil; rsmooth:=ValueArray;

ArrayExpanding(rsmooth,ExpandCoef); ArrayLengthening(smoothA,SplitCoef);

if FilterType=1 then if CycledFilter then for j:=2 to SplitCoef do

SevenPointNonLinearSmoothing(smoothA,Dsc,j) else

SevenPointNonLinearSmoothing(smoothA,Dsc,SplitCoef);

if FilterType=2 then CubicSplineSmoothing(smoothA,Dsc,SplitCoef);

ArrayShortening(smoothA,SplitCoef); ValueArray:=smoothA;

end;

 

//Расширение массива заданным числом точек справа и слева

procedure ArrayLengthening(var ValueArray: TDoubleArray; SplitValue: integer);

var sv,N,i: integer;

   bv,ev: double;

begin

N:=Length(ValueArray); sv:=10*SplitValue; bv:=0; ev:=0;

for i:=0 to 9 do bv:=bv+ValueArray[i]; bv:=bv/10;

for i:=N-1 downto N-10 do ev:=ev+ValueArray[i]; ev:=ev/10;

SetLength(ValueArray,N+sv);

for i:=N-1 downto 0 do ValueArray[i+trunc(sv/2)]:=ValueArray[i];

for i:=trunc(sv/2)-1 downto 0 do ValueArray[i]:=bv;

for i:=N+trunc(sv/2) to N+sv-1 do ValueArray[i]:=ev;

end;

 

//Сокращение массива заданным числом точек справа и слева

procedure ArrayShortening(var ValueArray: TDoubleArray; SplitValue: integer);

var sv,N,i: integer;

begin

N:=Length(ValueArray); sv:=10*SplitValue;

for i:=0 to N-sv-1 do ValueArray[i]:=ValueArray[i+trunc(sv/2)];

SetLength(ValueArray,N-sv);

end;

 

//Расширение массива заданным числом точек между 2-мя соседними

procedure ArrayExpanding(var ValueArray: TDoubleArray; ExpandCoef: integer);

var i,k,N,sub: integer;

   diap: double;

begin

N:=Length(ValueArray); sub:=ExpandCoef-1;

SetLength(smoothA,N*ExpandCoef-sub);

for i:=0 to N-1 do begin smoothA[i*ExpandCoef]:=ValueArray[i];

if i<>0 then begin diap:=(smoothA[i*ExpandCoef]-smoothA[(i-1)*ExpandCoef]);

for k:=0 to ExpandCoef-1 do smoothA[(i-1)*ExpandCoef+k]:=

smoothA[(i-1)*ExpandCoef]+diap*(k/ExpandCoef); end; end;

end;

 

//Линейная регрессия

procedure LinearRegression(ValueArray,ArgumentArray: TDoubleArray; SourceSeries,

                          DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

                          SeriesColor: TColor; var Hint: string);

var b0,b1,xsum,ysum,pxy,xsqua: double;

   y,x: array of double;

   i,N: integer;

   s: string;

begin

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; pxy:=0; xsqua:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

pxy:=pxy+x[i]*y[i]; xsqua:=xsqua+x[i]*x[i]; end; xsum:=Sum(x); ysum:=Sum(y);

b1:=(xsum*ysum-N*pxy)/(xsum*xsum-N*xsqua); b0:=(ysum-b1*xsum)/N;

MainCoef:=b1; FreeCoef:=b0;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

b1*ArgumentArray[i]+b0,'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

b1*SourceSeries.XValues.Value[i]+b0,'',SeriesColor);

if b0<0 then s:='' else s:='+ ';

Hint:=Format('%0.3f',[b1])+'*X '+s+Format('%0.3f',[b0]); x:=nil; y:=nil;

end;

 

//Гиперболическая регрессия

procedure HyperbolicRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

         SeriesColor: TColor; var Hint: string);

var b0,b1,ax,ysum,axsqua,dxy: double;

   y,x: array of double;

   i,N: integer;

   s: string;

begin

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; axsqua:=0; ax:=0; dxy:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

if x[i]=0 then begin MessageDlg('Hyperbolic regression inapplicable...',

mtWarning,[mbOk],0); Hint:='No equation'; MainCoef:=0; FreeCoef:=0; Exit; end;

dxy:=dxy+y[i]/x[i]; ax:=ax+1/x[i]; axsqua:=axsqua+1/(x[i]*x[i]); end;

ysum:=Sum(y); b1:=(dxy-(ysum*ax)/N)/(axsqua-(ax*ax)/N); b0:=(ysum-b1*ax)/N;

MainCoef:=b1; FreeCoef:=b0;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

b1/ArgumentArray[i]+b0,'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

b1/SourceSeries.XValues.Value[i]+b0,'',SeriesColor);

if b0<0 then s:='' else s:='+ ';

Hint:=Format('%0.3f',[b1])+'/X '+s+Format('%0.3f',[b0]); x:=nil; y:=nil;

end;

 

//Степенная регрессия

procedure PowerRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

         SeriesColor: TColor; var Hint: string);

var b0,b1,lnx,lny,xlnsqua,plnxy: double;

   y,x: array of double;

   i,N: integer;

begin

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; lnx:=0; lny:=0; xlnsqua:=0; plnxy:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

if (x[i]<=0) or (y[i]<=0) then begin

MessageDlg('Power regression inapplicable...',mtWarning,[mbOk],0);

Hint:='No equation'; MainCoef:=0; FreeCoef:=0; Exit; end;

lnx:=lnx+ln(x[i]); lny:=lny+ln(y[i]); plnxy:=plnxy+ln(x[i])*ln(y[i]);

xlnsqua:=xlnsqua+ln(x[i])*ln(x[i]); end;

b1:=(lnx*lny-N*plnxy)/(lnx*lnx-N*xlnsqua); b0:=exp((lny-b1*lnx)/N);

MainCoef:=b1; FreeCoef:=b0;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

Power(ArgumentArray[i],b1)*b0,'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

Power(SourceSeries.XValues.Value[i],b1)*b0,'',SeriesColor);

Hint:=Format('%0.3f',[b0])+'*X^'+Format('%0.3f',[b1]); x:=nil; y:=nil;

end;

 

//Полиномиальная регрессия

procedure PolynomialRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; PolyDegree: integer;

         var ArrayCoefs: TDoubleArray; SeriesColor: TColor; var Hint: string);

var bcoef,dcoef: TDoubleArray;

   ccoef: array of TDoubleArray;

   i,j,k,N: integer;

   polynom: double;

begin

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; Hint:='';

ArrayCoefs:=nil; SetLength(ccoef,PolyDegree+1);

for i:=0 to Length(ccoef)-1 do SetLength(ccoef[i],PolyDegree+1);

SetLength(dcoef,PolyDegree+1); SetLength(bcoef,PolyDegree+1);

for i:=0 to Length(dcoef)-1 do begin dcoef[i]:=0;

for j:=0 to N-1 do begin if ValueArray<>nil then dcoef[i]:=dcoef[i]+

Power(ArgumentArray[j],i)*ValueArray[j] else

dcoef[i]:=dcoef[i]+Power(SourceSeries.XValues.Value[j],i)*

SourceSeries.YValues.Value[j]; end;

for j:=0 to Length(ccoef)-1 do begin ccoef[i][j]:=0;

for k:=0 to N-1 do begin if ValueArray<>nil then ccoef[i][j]:=

ccoef[i][j]+Power(ArgumentArray[k],i+j) else

ccoef[i][j]:=ccoef[i][j]+Power(SourceSeries.XValues.Value[k],i+j);

end; end; end;

for i:=0 to Length(ccoef)-2 do for j:=i+1 to Length(ccoef)-1 do begin

ccoef[j][i]:=-ccoef[j][i]/ccoef[i][i];

dcoef[j]:=dcoef[j]+ccoef[j][i]*dcoef[i];

for k:=i+1 to Length(ccoef)-1 do

ccoef[j][k]:=ccoef[j][k]+ccoef[j][i]*ccoef[i][k]; end;

bcoef[Length(bcoef)-1]:=dcoef[Length(dcoef)-1]/

ccoef[Length(bcoef)-1][Length(bcoef)-1];

for i:=Length(ccoef)-2 downto 0 do begin

for j:=i+1 to Length(ccoef)-1 do bcoef[i]:=bcoef[i]+bcoef[j]*ccoef[i][j];

bcoef[i]:=(dcoef[i]-bcoef[i])/ccoef[i][i]; end;

SetLength(ArrayCoefs,Length(bcoef));

for i:=0 to Length(bcoef)-1 do ArrayCoefs[i]:=bcoef[i];

if DestSeries<>nil then for i:=0 to N-1 do begin polynom:=0;

if ValueArray<>nil then begin

for j:=0 to PolyDegree do polynom:=polynom+bcoef[j]*Power(ArgumentArray[i],j);

DestSeries.AddXY(ArgumentArray[i],polynom,'',SeriesColor); end else begin

for j:=0 to PolyDegree do polynom:=polynom+

bcoef[j]*Power(SourceSeries.XValues.Value[i],j);

DestSeries.AddXY(SourceSeries.XValues.Value[i],

polynom,'',SeriesColor); end; end;

for j:=PolyDegree downto 0 do

Hint:=Hint+Format('%0.3f',[bcoef[j]])+'*X^'+IntToStr(j);

dcoef:=nil; bcoef:=nil; ccoef:=nil;

end;

 

//Показательная регрессия

procedure ExponentRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

         SeriesColor: TColor; var Hint: string; Warning: boolean);

var i,N: integer;

   x,y: array of double;

   lgy,xsum,xsqua,a,b,lga,xlgy,lgb: double;

begin

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; lgy:=0; xsqua:=0; xlgy:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

if y[i]<=0 then begin if Warning then

MessageDlg('Exponent regression inapplicable',

mtWarning,[mbOk],0); Hint:='No equation'; MainCoef:=0; FreeCoef:=0; Exit; end;

lgy:=lgy+Log10(y[i]); xsqua:=xsqua+x[i]*x[i];

xlgy:=xlgy+x[i]*Log10(y[i]); end; xsum:=Sum(x);

lgb:=(xlgy-(lgy*xsum)/N)/(xsqua-(xsum*xsum)/N); lga:=(lgy-lgb*xsum)/N;

b:=Power(10,lgb); a:=Power(10,lga);

MainCoef:=b; FreeCoef:=a;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

a*Power(b,ArgumentArray[i]),'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

a*Power(b,SourceSeries.XValues.Value[i]),'',SeriesColor);

Hint:='Exponent regression equation: Y = '+

Format('%0.5f',[a])+' * ('+Format('%0.5f',[b])+' ^ X)'; x:=nil; y:=nil;

end;

 

//Экспоненциальная регрессия

procedure ExponentialRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

         SeriesColor: TColor; var Hint: string; Warning: boolean);

var i,N: integer;

   x,y: array of double;

   lny,xsum,xsqua,xlny,b0,b1: double;

begin

MainCoef:=0; FreeCoef:=0;

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; lny:=0; xsqua:=0; xlny:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

if y[i]<=0 then begin if Warning then

MessageDlg('Exponential regression inapplicable',

mtWarning,[mbOk],0); Hint:='No equation'; MainCoef:=0; FreeCoef:=0; Exit; end;

lny:=lny+Ln(y[i]); xsqua:=xsqua+x[i]*x[i];

xlny:=xlny+x[i]*Ln(y[i]); end; xsum:=Sum(x);

b1:=(xsum*lny-N*xlny)/(xsum*xsum-N*xsqua); b0:=exp((lny-b1*xsum)/N);

MainCoef:=b1; FreeCoef:=b0;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

b0*Exp(b1*ArgumentArray[i]),'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

b0*Exp(b1*SourceSeries.XValues.Value[i]),'',SeriesColor);

Hint:='Exponential regression equation: Y = '+

Format('%0.5f',[b0])+' * exp('+Format('%0.5f',[b1])+' * X)'; x:=nil; y:=nil;

end;

 

//Степенно-экспоненциальная регрессия

procedure ExpPowerRegression(ValueArray,ArgumentArray: TDoubleArray;

         SourceSeries,DestSeries: TChartSeries; var MainCoef,FreeCoef: double;

         SeriesColor: TColor; var Hint: string; Warning: boolean);

var i,N: integer;

   x,y: array of double;

   matr: array [0..3] of double;

   lny,xsum,xsqua,xlny,b0,b1: double;

begin

MainCoef:=0; FreeCoef:=0;

if ValueArray<>nil then N:=Length(ValueArray) else

N:=SourceSeries.XValues.Count; lny:=0; xsqua:=0; xlny:=0;

SetLength(x,N); SetLength(y,N);

for i:=0 to N-1 do begin if ValueArray<>nil then begin

y[i]:=ValueArray[i]; x[i]:=ArgumentArray[i]; end else begin

y[i]:=SourceSeries.YValues.Value[i];

x[i]:=SourceSeries.XValues.Value[i]; end;

if y[i]<=0 then begin if Warning then

MessageDlg('Exponent-Power regression inapplicable',

mtWarning,[mbOk],0); Hint:='No equation'; MainCoef:=0; FreeCoef:=0; Exit; end;

lny:=lny+Ln(y[i]); xsqua:=xsqua+x[i]*x[i];

xlny:=xlny+x[i]*Ln(y[i]); end; xsum:=Sum(x);

b1:=(xsum*lny-N*xlny)/(xsum*xsum-N*xsqua); b0:=exp((lny-b1*xsum)/N);

MainCoef:=b1; FreeCoef:=b0;

if DestSeries<>nil then for i:=0 to N-1 do

if ValueArray<>nil then DestSeries.AddXY(ArgumentArray[i],

b0*Exp(b1*ArgumentArray[i]),'',SeriesColor) else

DestSeries.AddXY(SourceSeries.XValues.Value[i],

b0*Exp(b1*SourceSeries.XValues.Value[i]),'',SeriesColor);

Hint:='Exponent-Power regression equation: Y = '+

Format('%0.5f',[b0])+' * exp('+Format('%0.5f',[b1])+' * X)'; x:=nil; y:=nil;

end;

 

//Общая процедура проверки массива

procedure CheckArrayBounds(var CArray: TDoubleArray; var FromPoint,ToPoint: integer);

begin

if FromPoint<0 then FromPoint:=0;

if (ToPoint<=0) or (ToPoint>Length(CArray)-1) then ToPoint:=Length(CArray)-1;

if FromPoint>ToPoint then ToPoint:=FromPoint;

end;

 

//Общая процедура проверки серии

procedure CheckSeriesBounds(CSeries: TChartSeries; var FromPoint,ToPoint: integer);

begin

if FromPoint<0 then FromPoint:=0;

if (ToPoint<=0) or (ToPoint>CSeries.XValues.Count-1) then

ToPoint:=CSeries.XValues.Count-1;

if FromPoint>ToPoint then ToPoint:=FromPoint;

end;

 

//Извлечение массива из массива

procedure ArrayFromArray(var SourceArray,DestArray: TDoubleArray;

         FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

var i: integer;

begin

DestArray:=nil;

if SourceArray=nil then DestArray:=nil else begin

CheckArrayBounds(SourceArray,FromPoint,ToPoint);

if Discrete=0 then Discrete:=1;

if Derivative=false then begin

SetLength(DestArray,((ToPoint-FromPoint) div Discrete)+1);

for i:=0 to Length(DestArray)-1 do DestArray[i]:=

SourceArray[i*Discrete+FromPoint]; end else begin

SetLength(DestArray,((ToPoint-FromPoint) div Discrete));

for i:=1 to Length(DestArray) do DestArray[i-1]:=

(SourceArray[i*Discrete+FromPoint]-

SourceArray[i*Discrete+FromPoint-1])/Discrete; end; end;

end;

 

//Извлечение массива из серии

procedure ArrayFromSeries(var ValueArray: TDoubleArray; DataSeries: TChartSeries;

         FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

var i: integer;

begin

if DataSeries=nil then ValueArray:=nil else with DataSeries do begin

CheckSeriesBounds(DataSeries,FromPoint,ToPoint);

if Discrete=0 then Discrete:=1;

if Derivative=false then begin

SetLength(ValueArray,((ToPoint-FromPoint) div Discrete)+1);

for i:=0 to Length(ValueArray)-1 do ValueArray[i]:=

YValues.Value[i*Discrete+FromPoint]; end else begin

SetLength(ValueArray,((ToPoint-FromPoint) div Discrete));

for i:=1 to Length(ValueArray) do ValueArray[i-1]:=

(YValues.Value[i*Discrete+FromPoint]-YValues.Value[i*Discrete+FromPoint-1])/

(XValues.Value[i*Discrete+FromPoint]-

XValues.Value[i*Discrete+FromPoint-1]); end; end;

end;

 

//Извлечение серии из массива

procedure SeriesFromArray(var ValueArray: TDoubleArray; DataSeries: TChartSeries;

         FromPoint,ToPoint,Discrete: integer; Derivative: boolean);

var i,n: integer;

begin

if DataSeries=nil then Exit else with DataSeries do begin Clear;

CheckArrayBounds(ValueArray,FromPoint,ToPoint);

if Discrete=0 then Discrete:=1;

if Derivative=false then begin n:=((ToPoint-FromPoint) div Discrete)+1;

for i:=0 to n-1 do DataSeries.AddXY(i,ValueArray[i*Discrete+FromPoint],

'',DataSeries.SeriesColor); end else begin

n:=(ToPoint-FromPoint) div Discrete;

for i:=1 to n do DataSeries.AddXY(i-1,(ValueArray[i*Discrete+FromPoint]-

ValueArray[i*Discrete+FromPoint-1])/Discrete,

'',DataSeries.SeriesColor); end; end;

end;

 

//Извлечение производной из массива

function DerivFromArray(var SourceArray: TDoubleArray; FromPoint,ToPoint,

        Discrete: integer; Extremum: string; var Position: integer): double;

var i: integer;

   d: double;

begin

DerivFromArray:=0;

if SourceArray=nil then DerivFromArray:=0 else begin

CheckArrayBounds(SourceArray,FromPoint,ToPoint);

if Discrete=0 then Discrete:=1;

SetLength(rv,(ToPoint-FromPoint) div Discrete);

for i:=1 to Length(rv) do rv[i-1]:=(SourceArray[i*Discrete+FromPoint]-

SourceArray[i*Discrete+FromPoint-1])/Discrete;

if Extremum='max' then d:=MaxValue(rv);

if Extremum='min' then d:=MinValue(rv);

if Extremum='mean' then d:=Mean(rv);

for i:=0 to Length(rv)-1 do

if rv[i]=d then begin Position:=i; break; end; DerivFromArray:=d; end;

end;

 

//Извлечение производной из серии

function DerivFromSeries(DataSeries: TChartSeries; FromPoint,ToPoint,

        Discrete: integer; Extremum: string; var Position: integer): double;

var i: integer;

   d: double;

begin

DerivFromSeries:=0;

if DataSeries=nil then DerivFromSeries:=0 else with DataSeries do begin

CheckSeriesBounds(DataSeries,FromPoint,ToPoint);

if Discrete=0 then Discrete:=1;

SetLength(rv,(ToPoint-FromPoint) div Discrete);

for i:=1 to Length(rv) do rv[i-1]:=(YValues.Value[i*Discrete+FromPoint]-

YValues.Value[i*Discrete+FromPoint-1])/(XValues.Value[i*Discrete+FromPoint]-

XValues.Value[i*Discrete+FromPoint-1]);

if Extremum='max' then d:=MaxValue(rv);

if Extremum='min' then d:=MinValue(rv);

if Extremum='mean' then d:=Mean(rv);

for i:=0 to Length(rv)-1 do

if rv[i]=d then begin Position:=i; break; end; DerivFromSeries:=d; end;

end;

 

//Извлечение величины из серии

function ValueFromSeries(DataSeries: TChartSeries; FromPoint,ToPoint: integer;

        Extremum: string; var Position: integer): double;

var i: integer;

   d: double;

begin

if DataSeries=nil then ValueFromSeries:=0 else with DataSeries do begin

CheckSeriesBounds(DataSeries,FromPoint,ToPoint);

SetLength(rv,ToPoint-FromPoint);

for i:=0 to Length(rv)-1 do rv[i]:=YValues.Value[FromPoint+i];

if Extremum='max' then d:=MaxValue(rv);

if Extremum='min' then d:=MinValue(rv);

if Extremum='mean' then d:=Mean(rv);

for i:=0 to Length(rv)-1 do

if rv[i]=d then begin Position:=i; break; end; ValueFromSeries:=d; end;

end;

 

//Извлечение величины из массива

function ValueFromArray(var SourceArray: TDoubleArray; FromPoint,

        ToPoint: integer; Extremum: string; var Position: integer): double;

var i: integer;

   d: double;

begin

if SourceArray=nil then ValueFromArray:=0 else begin

CheckArrayBounds(SourceArray,FromPoint,ToPoint);

SetLength(rv,ToPoint-FromPoint);

for i:=0 to Length(rv)-1 do rv[i]:=SourceArray[FromPoint+i];

if Extremum='max' then d:=MaxValue(rv);

if Extremum='min' then d:=MinValue(rv);

if Extremum='mean' then d:=Mean(rv);

for i:=0 to Length(rv)-1 do

if rv[i]=d then begin Position:=i; break; end; ValueFromArray:=d; end;

end;

 

//Вычисление площади под кривой, получаемой данными из массива

function CalculateAreaOfArray(var SourceArray: TDoubleArray;

        FromPoint,ToPoint,Method: integer; BindToZero: boolean): double;

var i: integer;

   sq,subv: double;

begin

if SourceArray=nil then CalculateAreaOfArray:=0 else begin

CheckArrayBounds(SourceArray,FromPoint,ToPoint); sq:=0;

if BindToZero then subv:=

(SourceArray[ToPoint]+SourceArray[FromPoint])/2 else subv:=0;

for i:=FromPoint to ToPoint-1 do begin

if Method=1 then sq:=sq+Abs(SourceArray[i]-subv)+

(Abs(SourceArray[i+1]-subv)-Abs(SourceArray[i]-subv))/2;

if Method=2 then sq:=sq+Abs(SourceArray[i]-subv)+

(Abs(SourceArray[i+1]-subv)-Abs(SourceArray[i]-subv))/2-1/(48*Power(0.5,1.5));

if Method=3 then if (i mod 2)=1 then sq:=sq+2*Abs(SourceArray[i]-subv);

if Method=4 then if (i mod 2)=1 then

sq:=sq+2*Abs(SourceArray[i]-subv)-1/(96*Power(0.5,1.5)); end;

CalculateAreaOfArray:=sq; end;

end;

 

//Вычисление площади под кривой, получаемой данными из серии

function CalculateAreaOfSeries(DataSeries: TChartSeries; FromPoint,ToPoint,

        Method: integer; BindToZero: boolean): double;

var i: integer;

   sq,subv: double;

begin

if DataSeries=nil then CalculateAreaOfSeries:=0 else with DataSeries do begin

CheckSeriesBounds(DataSeries,FromPoint,ToPoint); sq:=0;

if BindToZero then subv:=(YValues.Value[ToPoint]+

YValues.Value[FromPoint])/2 else subv:=0;

for i:=FromPoint to ToPoint-1 do begin

if Method=1 then sq:=sq+Abs(YValues.Value[i]-subv)+

(Abs(YValues.Value[i+1]-subv)-Abs(YValues.Value[i]-subv))/2;

if Method=2 then sq:=sq+Abs(YValues.Value[i]-subv)+

(Abs(YValues.Value[i+1]-subv)-

Abs(YValues.Value[i]-subv))/2-1/(48*Power(0.5,1.5));

if Method=3 then if (i mod 2)=1 then sq:=sq+2*Abs(YValues.Value[i]-subv);

if Method=4 then if (i mod 2)=1 then

sq:=sq+2*Abs(YValues.Value[i]-subv)-1/(96*Power(0.5,1.5)); end;

CalculateAreaOfSeries:=sq; end;

end;

 

//Исключение линейной составляющей

procedure LinearTrendExclusion(var ValueArray: TDoubleArray);

var i,N: integer;

   b0,b1,nx: double;

begin

N:=Length(ValueArray); nx:=0;

for i:=0 to N-1 do nx:=nx+(i+1)*ValueArray[i];

b0:=(2*(2*N+1)*Sum(ValueArray)-6*nx)/(N*(N-1));

b1:=(12*nx-6*(N+1)*Sum(ValueArray))/(N*(N-1)*(N+1));

for i:=0 to N-1 do begin ValueArray[i]:=ValueArray[i]-(i*b1); end;

end;

 

//Расцветка серии

procedure ColorizeSeries(DataSeries: TChartSeries; NewColor: TColor);

var i: integer;

begin

for i:=0 to DataSeries.XValues.Count-1 do

DataSeries.ValueColor[i]:=NewColor;

end;

 

//Задание нового приращения по оси X

procedure SetXInterval(DataSeries: TChartSeries; XInterval: double);

var i: integer;

begin

for i:=0 to DataSeries.XValues.Count-1 do

DataSeries.XValues.Value[i]:=DataSeries.XValues.Value[i]*XInterval;

end;

 

//Привязка серии к новой оси

procedure SetSeriesAxis(DataSeries: TChartSeries; NewAxis: TVertAxis);

begin

DataSeries.VertAxis:=NewAxis;

end;

 

end.

 

©Drkb::03964