Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Фильтрация, регрессия, работа с массивом и серией
 
Модуль предназначен для выполнения процедур:
- фильтрации
- регрессии
- операций с массивами
- операций с сериями
 
Зависимости: 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.