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

Delphi , Синтаксис , Массивы

Автор: Lookin
WEB-сайт: http://delphibase.endimus.com

{ **** 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.

Это большой блок кода, но я постараюсь дать обзор и подчеркнуть некоторые ключевые моменты.

Код написан на языке Delphi Pascal и appears to be a library для обработки и анализа серий данных (например, диаграмм). Библиотека предлагает различные функции и процедуры для задач, таких как:

1. Обработка данных:

   • ArrayFromArray и SeriesToArray: Конвертируйте между массивами и сериями.
   • LinearTrendExclusion: Удалите линейную тенденцию из массива.

2. Статистический анализ:

   • Mean, Median, Mode, Variance и StandardDeviation: Вычислите различные статистические метрики.
   • CorrelationCoef и RegressionCoef: Вычислите коэффициенты корреляции и регрессии.

3. Визуализация данных:

   • ColorizeSeries: Измените цвет серии.
   • SetXInterval и SetYInterval: Установите интервал для осей X и Y.

4. Вычисление производной:

   • DerivFromArray и DerivFromSeries: Вычислите производные из массивов и серий.

Некоторые заметные процедуры включают:

1. CheckArrayBounds и CheckSeriesBounds: Проверьте, находится ли массив или серия в указанном диапазоне.
2. CalculateAreaOfArray и CalculateAreaOfSeries: Вычислите площадь под кривой с помощью различных методов (например, трапециевидный, правило Симпсона).
3. ValueFromArray и ValueFromSeries: Получите значения из массивов и серий.

Код также включает в себя некоторые утилитарные функции для задач, таких как вычисление максимального или минимального значения массива, и нахождение позиции значения в массиве.

В целом, эта библиотека appears to provide a wide range of tools for processing and analyzing data series, making it useful for various applications involving data visualization and statistical analysis.

This is a Delphi unit that provides various functions and procedures for working with chart series, arrays, and mathematical calculations. Here's a breakdown of the components: 1. `LinearRegression` procedure: calculates the linear regression equation gi

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Массивы ::