You've already forked lazarus-ccr
1205 lines
36 KiB
Plaintext
1205 lines
36 KiB
Plaintext
|
unit AutoCorUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, ExtCtrls, Buttons, MainUnit, functionsLib, OutPutUnit, Globals, GraphLib,
|
||
|
|
DataProcs, MatrixLib, PointsUnit, ExpSmoothUnit, DifferenceUnit,FFTUnit,
|
||
|
|
PolynomialUnit, Math, contexthelpunit;
|
||
|
|
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TAutocorrFrm }
|
||
|
|
|
||
|
|
TAutocorrFrm = class(TForm)
|
||
|
|
AlphaEdit: TEdit;
|
||
|
|
HelpBtn: TButton;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
CancelBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
ReturnBtn: TButton;
|
||
|
|
PlotChk: TCheckBox;
|
||
|
|
StatsChk: TCheckBox;
|
||
|
|
RMatChk: TCheckBox;
|
||
|
|
PartialsChk: TCheckBox;
|
||
|
|
YuleWalkerChk: TCheckBox;
|
||
|
|
ResidChk: TCheckBox;
|
||
|
|
GroupBox5: TGroupBox;
|
||
|
|
MaxLagEdit: TEdit;
|
||
|
|
InBtn: TBitBtn;
|
||
|
|
Label5: TLabel;
|
||
|
|
Label6: TLabel;
|
||
|
|
OutBtn: TBitBtn;
|
||
|
|
DepVarEdit: TEdit;
|
||
|
|
Label3: TLabel;
|
||
|
|
Label4: TLabel;
|
||
|
|
VarList: TListBox;
|
||
|
|
MRegSmoothChk: TCheckBox;
|
||
|
|
PolyChk: TCheckBox;
|
||
|
|
FourierSmoothChk: TCheckBox;
|
||
|
|
ExpSmoothChk: TCheckBox;
|
||
|
|
MoveAvgChk: TCheckBox;
|
||
|
|
DifferenceChk: TCheckBox;
|
||
|
|
MeanChk: TCheckBox;
|
||
|
|
GroupBox4: TGroupBox;
|
||
|
|
Label2: TLabel;
|
||
|
|
ProjPtsEdit: TEdit;
|
||
|
|
ProjectChk: TCheckBox;
|
||
|
|
FromCaseEdit: TEdit;
|
||
|
|
GroupBox3: TGroupBox;
|
||
|
|
ToCaseEdit: TEdit;
|
||
|
|
GroupBox1: TGroupBox;
|
||
|
|
GroupBox2: TGroupBox;
|
||
|
|
Label1: TLabel;
|
||
|
|
ColBtn: TRadioButton;
|
||
|
|
AllCasesBtn: TRadioButton;
|
||
|
|
OnlyCasesBtn: TRadioButton;
|
||
|
|
RowBtn: TRadioButton;
|
||
|
|
procedure ColBtnClick(Sender: TObject);
|
||
|
|
procedure ComputeBtnClick(Sender: TObject);
|
||
|
|
procedure FormShow(Sender: TObject);
|
||
|
|
procedure HelpBtnClick(Sender: TObject);
|
||
|
|
procedure InBtnClick(Sender: TObject);
|
||
|
|
procedure OutBtnClick(Sender: TObject);
|
||
|
|
procedure ResetBtnClick(Sender: TObject);
|
||
|
|
procedure ReturnBtnClick(Sender: TObject);
|
||
|
|
procedure RowBtnClick(Sender: TObject);
|
||
|
|
private
|
||
|
|
{ private declarations }
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
procedure four1(VAR data : DblDyneVec; nn : longword; isign : integer);
|
||
|
|
procedure realft(VAR data : DblDyneVec; n : longword; isign : integer);
|
||
|
|
procedure fourier(VAR data : DblDyneVec; n : integer; npts : integer);
|
||
|
|
procedure PolyFit(VAR pts : DblDyneVec; VAR avg : DblDyneVec;
|
||
|
|
NoPts : integer);
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
AutocorrFrm: TAutocorrFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
uses MoveAvgUnit, AutoPlotUnit;
|
||
|
|
|
||
|
|
{ TAutocorrFrm }
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
VarList.Clear;
|
||
|
|
DepVarEdit.Text := '';
|
||
|
|
MaxLagEdit.Text := '30';
|
||
|
|
StatsChk.Checked := false;
|
||
|
|
RmatChk.Checked := false;
|
||
|
|
PartialsChk.Checked := false;
|
||
|
|
PlotChk.Checked := true;
|
||
|
|
ResidChk.Checked := false;
|
||
|
|
DifferenceChk.Checked := false;
|
||
|
|
PolyChk.Checked := false;
|
||
|
|
MeanChk.Checked := false;
|
||
|
|
MoveAvgChk.Checked := false;
|
||
|
|
ExpSmoothChk.Checked := false;
|
||
|
|
FourierSmoothChk.Checked := false;
|
||
|
|
YuleWalkerChk.Checked := false;
|
||
|
|
FromCaseEdit.Text := '';
|
||
|
|
ToCaseEdit.Text := '';
|
||
|
|
AllCasesBtn.Checked := true;
|
||
|
|
InBtn.Visible := true;
|
||
|
|
OutBtn.Visible := false;
|
||
|
|
AlphaEdit.Text := '0.05';
|
||
|
|
ProjPtsEdit.Text := '';
|
||
|
|
if ColBtn.Checked = true then
|
||
|
|
begin
|
||
|
|
for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if IsFiltered(i) then continue;
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[0,i]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.ReturnBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
AutocorrFrm.Hide;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.RowBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
VarList.Clear;
|
||
|
|
for i := 1 to NoCases do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[0,i]);
|
||
|
|
GroupBox2.Caption := 'Include Columns:';
|
||
|
|
AllCasesBtn.Caption := 'All Variables';
|
||
|
|
OnlyCasesBtn.Caption := 'Only Columns From:';
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.HelpBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
var
|
||
|
|
X, Y, count, alphaval, covzero,mean1,mean2, var1, var2, mean : double;
|
||
|
|
sd1, sd2, uplimit, lowlimit, varresid, StdErr, alpha, difference : double;
|
||
|
|
NoPts, DepVar, maxlag, lag, noproj : integer;
|
||
|
|
i, j, k, ncors, npoints, nvalues, t : integer;
|
||
|
|
Means, StdDevs, PartCors, residual, betas, rxy, pts, avg : DblDyneVec;
|
||
|
|
correlations, a : DblDyneMat;
|
||
|
|
RowLabels, ColLabels : StrDyneVec;
|
||
|
|
Title : string;
|
||
|
|
r, vx, vy, sx, sy, mx, my, UCL, LCL, Yhat, Constant : double;
|
||
|
|
outline, cellstring : string;
|
||
|
|
ColNoSelected : IntDyneVec;
|
||
|
|
NoSelected : integer;
|
||
|
|
negative : boolean;
|
||
|
|
Msg : string;
|
||
|
|
zconf, samptrans, z : double;
|
||
|
|
confidence, StdDevY : double;
|
||
|
|
upper : array[0..300] of double;
|
||
|
|
lower : array[0..300] of double;
|
||
|
|
lagvalue : array[0..300] of integer;
|
||
|
|
|
||
|
|
begin
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
SetLength(ColNoSelected,NoVariables);
|
||
|
|
if ColBtn.Checked = true then
|
||
|
|
begin
|
||
|
|
// get column of the selected variable
|
||
|
|
DepVar := 0;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
if (OS3MainFrm.DataGrid.Cells[i,0] = DepVarEdit.Text) then DepVar := i;
|
||
|
|
if (DepVar = 0)then
|
||
|
|
begin
|
||
|
|
ShowMessage('No variable selected to analyze.');
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
ColNoSelected[0] := DepVar;
|
||
|
|
NoSelected := 1;
|
||
|
|
// get no. of valid points
|
||
|
|
NoPts := 0;
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
if ValidValue(i,DepVar) then NoPts := NoPts + 1;
|
||
|
|
end
|
||
|
|
else begin // get row of the selected case
|
||
|
|
DepVar := 0;
|
||
|
|
for i := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if NOT GoodRecord(i,NoSelected,ColNoSelected) then continue;
|
||
|
|
if (OS3MainFrm.DataGrid.Cells[0,i] = DepVarEdit.Text) then DepVar := i;
|
||
|
|
end;
|
||
|
|
if (DepVar = 0)then
|
||
|
|
begin
|
||
|
|
ShowMessage('No variable selected to analyze.');
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
ColNoSelected[0] := DepVar;
|
||
|
|
NoSelected := 1;
|
||
|
|
NoPts := NoVariables;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Get the alpha level and the maximum lag values
|
||
|
|
alpha := 1.0 - StrToFloat(AlphaEdit.Text);
|
||
|
|
if ProjectChk.Checked then noproj := StrToInt(ProjPtsEdit.Text) else noproj := 0;
|
||
|
|
maxlag := StrToInt(MaxLagEdit.Text);
|
||
|
|
if maxlag > NoPts div 2 then maxlag := NoPts div 2;
|
||
|
|
if StrToInt(MaxLagEdit.Text) > maxlag then MaxLagEdit.Text := IntToStr(maxlag);
|
||
|
|
npoints := maxlag + 2;
|
||
|
|
|
||
|
|
// allocate space for covariance and correlation matrices, etc.
|
||
|
|
SetLength(correlations,npoints+1,npoints+1);
|
||
|
|
SetLength(Means,npoints);
|
||
|
|
SetLength(StdDevs,npoints);
|
||
|
|
SetLength(RowLabels,npoints);
|
||
|
|
SetLength(ColLabels,npoints);
|
||
|
|
SetLength(PartCors,npoints);
|
||
|
|
SetLength(a,npoints,npoints);
|
||
|
|
SetLength(betas,npoints);
|
||
|
|
SetLength(rxy,npoints);
|
||
|
|
SetLength(pts,NoPts+noproj+10);
|
||
|
|
SetLength(avg,NoPts+noproj+10);
|
||
|
|
SetLength(residual,NoPts+noproj+10);
|
||
|
|
|
||
|
|
// Initialize arrays
|
||
|
|
for i := 0 to npoints-1 do
|
||
|
|
begin
|
||
|
|
for j := 0 to npoints - 1 do
|
||
|
|
begin
|
||
|
|
correlations[i,j] := 0.0;
|
||
|
|
a[i,j] := 0.0;
|
||
|
|
end;
|
||
|
|
Means[i] := 0.0;
|
||
|
|
StdDevs[i] := 0.0;
|
||
|
|
cellstring := 'Lag ';
|
||
|
|
cellstring := cellstring + IntToStr(i);
|
||
|
|
RowLabels[i] := cellstring;
|
||
|
|
ColLabels[i] := RowLabels[i];
|
||
|
|
PartCors[i] := 0.0;
|
||
|
|
betas[i] := 0.0;
|
||
|
|
end;
|
||
|
|
uplimit := 0.0;
|
||
|
|
lowlimit := 0.0;
|
||
|
|
covzero := 0.0;
|
||
|
|
|
||
|
|
// Get points to analyze
|
||
|
|
if ColBtn.Checked = true then
|
||
|
|
begin
|
||
|
|
if AllCasesBtn.Checked = true then
|
||
|
|
begin
|
||
|
|
for i := 1 to NoPts do
|
||
|
|
begin
|
||
|
|
if NOT ValidValue(i,DepVar) then continue;
|
||
|
|
pts[i-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVar,i]);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
NoPts := 0;
|
||
|
|
for i := StrToInt(FromCaseEdit.Text) to StrToInt(ToCaseEdit.Text) do
|
||
|
|
begin
|
||
|
|
if NOT ValidValue(i,DepVar) then continue;
|
||
|
|
pts[NoPts] := StrToFloat(OS3MainFrm.DataGrid.Cells[DepVar,i]);
|
||
|
|
NoPts := NoPts + 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin // row button selected
|
||
|
|
if AllCasesBtn.Checked = true then
|
||
|
|
begin
|
||
|
|
for i := 1 to NoPts do
|
||
|
|
begin
|
||
|
|
if Not ValidValue(DepVar,i) then continue;
|
||
|
|
pts[i-1] := StrToFloat(OS3MainFrm.DataGrid.Cells[i,DepVar]);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
NoPts := 0;
|
||
|
|
for i := StrToInt(FromCaseEdit.Text) to StrToInt(ToCaseEdit.Text) do
|
||
|
|
begin
|
||
|
|
if Not ValidValue(DepVar,i) then continue;
|
||
|
|
pts[NoPts] := StrToFloat(OS3MainFrm.DataGrid.Cells[i,DepVar]);
|
||
|
|
NoPts := NoPts + 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Calculate mean of all values
|
||
|
|
mean := 0.0;
|
||
|
|
count := NoPts;
|
||
|
|
for i := 1 to NoPts do mean := mean + pts[i-1];
|
||
|
|
|
||
|
|
correlations[0,0] := 1.0;
|
||
|
|
mean := mean / count;
|
||
|
|
|
||
|
|
// Remove mean from all observations if elected
|
||
|
|
if (MeanChk.Checked) then
|
||
|
|
for i := 1 to NoPts do pts[i-1] := pts[i-1] - mean;
|
||
|
|
|
||
|
|
// Get differences for lag specified
|
||
|
|
if (DifferenceChk.Checked) then
|
||
|
|
begin
|
||
|
|
if (DifferenceFrm.ShowModal = mrOK) then
|
||
|
|
begin
|
||
|
|
lag := StrToInt(DifferenceFrm.LagEdit.Text);
|
||
|
|
for i := 0 to NoPts - 1 do avg[i] := pts[i];
|
||
|
|
for j := 1 to StrToInt(DifferenceFrm.OrderEdit.Text) do
|
||
|
|
begin
|
||
|
|
for i := NoPts downto lag do
|
||
|
|
begin
|
||
|
|
avg[i] := avg[i] - avg[i-lag];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// plot the original and differenced values
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Differenced';
|
||
|
|
Msg := 'No. points = ';
|
||
|
|
Msg := Msg + IntToStr(NoCases);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.Title := 'Differencing Smoothed';
|
||
|
|
PointsFrm.Caption := 'Difference Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
if (ResidChk.Checked = true) then // calculate and plot residuals;
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / NoPts;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Difference Smoothing';
|
||
|
|
PointsFrm.Caption := 'Difference Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
end;
|
||
|
|
// replace original points with smoothed values
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Get moving average if checked
|
||
|
|
if (MoveAvgChk.Checked) then
|
||
|
|
begin
|
||
|
|
MoveAvgFrm.ShowModal;
|
||
|
|
nvalues := MoveAvgFrm.order;
|
||
|
|
if (nvalues > 0) then
|
||
|
|
begin
|
||
|
|
// plot the original points and the smoothed average
|
||
|
|
for i := nvalues to NoPts - nvalues - 1 do
|
||
|
|
begin
|
||
|
|
avg[i] := pts[i] * MoveAvgFrm.W[0]; // middle value
|
||
|
|
for j := 1 to nvalues do // left values
|
||
|
|
avg[i] := avg[i] + (pts[i-j] * MoveAvgFrm.W[j]);
|
||
|
|
for j := 1 to nvalues do // right values
|
||
|
|
avg[i] := avg[i] + (pts[i+j] * MoveAvgFrm.W[j]);
|
||
|
|
end;
|
||
|
|
// fill in unestimable averages with original points
|
||
|
|
for i := 0 to nvalues - 1 do // left values
|
||
|
|
begin
|
||
|
|
avg[i] := pts[i] * MoveAvgFrm.W[0];
|
||
|
|
for j := 1 to nvalues do
|
||
|
|
avg[i] := avg[i] + (pts[i+j] * 2.0 * MoveAvgFrm.W[j]);
|
||
|
|
end;
|
||
|
|
for i := NoPts - nvalues to NoPts - 1 do //right values
|
||
|
|
begin
|
||
|
|
avg[i] := pts[i] * MoveAvgFrm.W[0];
|
||
|
|
for j := 1 to nvalues do
|
||
|
|
avg[i] := avg[i] + (pts[i-j] * 2.0 * MoveAvgFrm.W[j]);
|
||
|
|
end;
|
||
|
|
if ProjectChk.Checked then
|
||
|
|
begin
|
||
|
|
for i := 0 to noproj-1 do
|
||
|
|
begin
|
||
|
|
avg[NoPts+i] := avg[NoPts-1];
|
||
|
|
pts[NoPts+i] := pts[NoPts-1];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// plot the points
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts+noproj;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Smoothed';
|
||
|
|
Msg := 'No. points = ';
|
||
|
|
Msg := Msg + IntToStr(NoPts);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.Title := 'Moving Average Smoothed';
|
||
|
|
PointsFrm.Caption := 'Moving Average Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
if (ResidChk.Checked = true) then // calculate and plot residuals;
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / NoPts;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Moving Average';
|
||
|
|
PointsFrm.Caption := 'Moving Average Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
end;
|
||
|
|
// replace original points with smoothed values
|
||
|
|
for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// do exponential smoothing if requested
|
||
|
|
if (ExpSmoothChk.Checked = true) then
|
||
|
|
begin
|
||
|
|
ExpSmoothFrm.ShowModal;
|
||
|
|
alpha := ExpSmoothFrm.alpha;
|
||
|
|
avg[0] := pts[0]; // set first value := to observed
|
||
|
|
for t := 1 to NoPts - 1 do // case pointer
|
||
|
|
begin
|
||
|
|
avg[t] := alpha * pts[t];
|
||
|
|
avg[t] := avg[t] + (1.0 - alpha) * avg[t-1];
|
||
|
|
end;
|
||
|
|
if ProjectChk.Checked then
|
||
|
|
begin
|
||
|
|
for i := 0 to noproj-1 do
|
||
|
|
begin
|
||
|
|
avg[NoPts+i] := alpha * pts[NoPts+i-1];
|
||
|
|
avg[NoPts+i] := avg[NoPts+i] + ((1.0 - alpha) * avg[NoPts+i-1]);
|
||
|
|
pts[NoPts+i] := avg[NoPts+i];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
// plot the points
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts+noproj;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Smoothed';
|
||
|
|
PointsFrm.Title := 'Exponential Smoothed';
|
||
|
|
PointsFrm.Caption := 'Exponential Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
if (ResidChk.Checked = true) then // calculate and plot residuals;
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / NoPts;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Exponential Smoothing';
|
||
|
|
PointsFrm.Caption := 'Exponential Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
end;
|
||
|
|
// replace original points with smoothed values
|
||
|
|
for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Fast Fourier smoothing, if requested
|
||
|
|
if (FourierSmoothChk.Checked = true) then
|
||
|
|
begin
|
||
|
|
for i := 0 to NoPts - 1 do avg[i] := pts[i];
|
||
|
|
if ProjectChk.Checked then
|
||
|
|
begin
|
||
|
|
for i := 0 to noproj - 1 do
|
||
|
|
begin
|
||
|
|
avg[i] := pts[NoPts-1-noproj+i];
|
||
|
|
pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
FFTFrm.NptsEdit.Text := IntToStr(NoPts+noproj+1);
|
||
|
|
FFTFrm.ShowModal;
|
||
|
|
nvalues := StrToInt(FFTFrm.NptsEdit.Text);
|
||
|
|
fourier(avg,nvalues,nvalues);
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts+noproj;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Smoothed';
|
||
|
|
PointsFrm.Title := 'Fourier Smoothed';
|
||
|
|
PointsFrm.Caption := 'Fourier Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
if (ResidChk.Checked = true) then // calculate and plot residuals;
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / NoPts;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Fourier Smoothing';
|
||
|
|
PointsFrm.Caption := 'Fourier Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
end;
|
||
|
|
// replace original points with smoothed values
|
||
|
|
for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Get polynomial regression fit if elected
|
||
|
|
if (PolyChk.Checked) then
|
||
|
|
begin
|
||
|
|
if (PolynomialFrm.ShowModal = mrOk) then
|
||
|
|
begin
|
||
|
|
if ProjectChk.Checked then
|
||
|
|
begin
|
||
|
|
for i := 0 to noproj - 1 do
|
||
|
|
begin
|
||
|
|
avg[i] := pts[NoPts-1-noproj+i];
|
||
|
|
pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
PolyFit(pts,avg,NoPts+noproj);
|
||
|
|
// plot original and smoothed data
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts+noproj;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Smoothed';
|
||
|
|
PointsFrm.Title := 'Polynomial Smoothed';
|
||
|
|
PointsFrm.Caption := 'Polynomial Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
// plot residuals if checked
|
||
|
|
if (ResidChk.Checked) then
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / NoPts;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Polynomial Smoothing';
|
||
|
|
PointsFrm.Caption := 'Polynomial Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
// PointsFrm.PtsPlot(self);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// replace original points with smoothed values
|
||
|
|
for i := 0 to (NoPts + noproj - 1) do pts[i] := avg[i];
|
||
|
|
end;
|
||
|
|
|
||
|
|
// get mean and variance of (transformed?) points
|
||
|
|
mean := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do mean := mean + pts[i];
|
||
|
|
mean := mean / NoPts;
|
||
|
|
for i := 1 to NoPts do
|
||
|
|
begin
|
||
|
|
X := pts[i-1];
|
||
|
|
if (MeanChk.Checked = true) then covzero := covzero + (X * X)
|
||
|
|
else covzero := covzero + ((X - mean) * (X - mean));
|
||
|
|
end;
|
||
|
|
covzero := covzero / count;
|
||
|
|
|
||
|
|
outline := format('Overall mean = %8.3f, variance = %8.3f',[mean,covzero]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
|
||
|
|
// get correlations for each lag 0 to maxlag
|
||
|
|
confidence := StrToFloat(AlphaEdit.Text);
|
||
|
|
ncors := 0;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('Lag Rxy MeanX MeanY Std.Dev.X Std.Dev.Y Cases LCL UCL');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
if maxlag > NoPts-3 then
|
||
|
|
begin
|
||
|
|
maxlag := NoPts - 3;
|
||
|
|
maxlagedit.Text := IntToStr(maxlag);
|
||
|
|
end;
|
||
|
|
for lag := 0 to maxlag do
|
||
|
|
begin
|
||
|
|
r := 0.0;
|
||
|
|
vx := 0.0;
|
||
|
|
vy := 0.0;
|
||
|
|
mx := 0.0;
|
||
|
|
my := 0.0;
|
||
|
|
Count := 0.0;
|
||
|
|
lagvalue[lag] := lag;
|
||
|
|
for i := 1 to (NoPts - lag) do
|
||
|
|
begin
|
||
|
|
X := pts[i-1];
|
||
|
|
Y := pts[i-1+lag];
|
||
|
|
if (MeanChk.Checked = true) then r := r + (X * Y)
|
||
|
|
else r := r + ((X - mean) * (Y - mean));
|
||
|
|
vx := vx + (X * X);
|
||
|
|
vy := vy + (Y * Y);
|
||
|
|
mx := mx + X;
|
||
|
|
my := my + Y;
|
||
|
|
Count := Count + 1.0;
|
||
|
|
end;
|
||
|
|
r := r / NoPts;
|
||
|
|
vx := vx - (mx * mx / Count);
|
||
|
|
vx := vx / (Count - 1.0);
|
||
|
|
sx := sqrt(vx);
|
||
|
|
vy := vy - (my * my / Count);
|
||
|
|
vy := vy / (Count - 1.0);
|
||
|
|
sy := sqrt(vy);
|
||
|
|
mx := mx / Count;
|
||
|
|
my := my / Count;
|
||
|
|
r := r / covzero;
|
||
|
|
if (abs(r) < 1.0) then samptrans := ln((1.0 + r) / (1.0 - r)) / 2.0;
|
||
|
|
// if above failed, r := 1.0
|
||
|
|
StdErr := sqrt(1.0 / (NoPts - 3.0));
|
||
|
|
zconf := abs(inversez(confidence / 2.0));
|
||
|
|
if (abs(r) < 1.0) then
|
||
|
|
begin
|
||
|
|
z := samptrans / StdErr;
|
||
|
|
UCL := samptrans + (zconf * StdErr);
|
||
|
|
LCL := samptrans - (zconf * StdErr);
|
||
|
|
UCL := (exp(2.0 * UCL) - 1.0) / (exp(2.0 * UCL) + 1.0);
|
||
|
|
LCL := (exp(2.0 * LCL) - 1.0) / (exp(2.0 * LCL) + 1.0);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
UCL := 1.0;
|
||
|
|
LCL := 1.0;
|
||
|
|
end;
|
||
|
|
upper[lag] := UCL;
|
||
|
|
lower[lag] := LCL;
|
||
|
|
outline := format('%4d %9.4f %9.4f %9.4f %9.4f %9.4f %9.0f %9.4f %9.4f',
|
||
|
|
[lag, r, mx, my, sx, sy, Count, LCL, UCL]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
ncors := ncors + 1;
|
||
|
|
correlations[0,lag] := r;
|
||
|
|
correlations[lag,0] := r;
|
||
|
|
end; // next lag
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
|
||
|
|
// build correlation matrix
|
||
|
|
for i := 0 to maxlag do correlations[i,i] := 1.0;
|
||
|
|
for i := 1 to maxlag do
|
||
|
|
begin
|
||
|
|
for j := i+1 to maxlag do
|
||
|
|
begin
|
||
|
|
correlations[i,j] := correlations[0,j-i];
|
||
|
|
correlations[j,i] := correlations[i,j];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Print the correlation matrix if elected
|
||
|
|
if (RmatChk.Checked = true) then
|
||
|
|
begin
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'Matrix of Lagged Variable: ';
|
||
|
|
Title := Title + DepVarEdit.Text;
|
||
|
|
MAT_PRINT(correlations,maxlag+1,maxlag+1,Title,RowLabels,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// Calculate partial correlations
|
||
|
|
PartCors[0] := 1.0;
|
||
|
|
for i := 1 to maxlag do // start at lag 1
|
||
|
|
begin
|
||
|
|
for j := 1 to i do
|
||
|
|
begin
|
||
|
|
for k := 1 to i do
|
||
|
|
begin
|
||
|
|
a[j-1,k-1] := correlations[j,k];
|
||
|
|
end;
|
||
|
|
rxy[j-1] := correlations[0,j];
|
||
|
|
end;
|
||
|
|
SVDinverse(a, i);
|
||
|
|
|
||
|
|
// get betas as product of inverse times vector
|
||
|
|
for j := 1 to i do
|
||
|
|
begin
|
||
|
|
betas[j-1] := 0.0;
|
||
|
|
for k := 1 to i do betas[j-1] := betas[j-1] + (a[j-1,k-1] * rxy[k-1]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
// get regression constant
|
||
|
|
// Note - since variance of Y and each X is the same, B = beta for an X
|
||
|
|
Constant := 0;
|
||
|
|
if MeanChk.Checked = false then
|
||
|
|
begin
|
||
|
|
for j := 1 to i do Constant := Constant + betas[j-1] * Mean;
|
||
|
|
Constant := Mean - Constant;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// calculate predicted value and residual
|
||
|
|
// Note - the dependent variable predicted is the next value in the
|
||
|
|
// time series using each of the previous time period values
|
||
|
|
Yhat := 0.0;
|
||
|
|
StdDevY := sqrt(covzero);
|
||
|
|
for j := 0 to i-1 do Yhat := Yhat + (betas[j] * pts[j]);
|
||
|
|
Yhat := Yhat + Constant;
|
||
|
|
avg[i] := Yhat;
|
||
|
|
residual[i] := pts[i] - Yhat;
|
||
|
|
|
||
|
|
// print betas if elected
|
||
|
|
if (YuleWalkerChk.Checked) then
|
||
|
|
begin
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'Yule-Walker Coefficients for lag ' + IntToStr(i);
|
||
|
|
DynVectorPrint(betas,i,Title,ColLabels,NoPts);
|
||
|
|
outline := format('Constant = %10.3f',[Constant]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PartCors[i] := betas[i-1];
|
||
|
|
end; // next i (lag from 1 to maxlag)
|
||
|
|
|
||
|
|
// print partial correlations if elected
|
||
|
|
if (PartialsChk.Checked = true) then
|
||
|
|
begin
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'Partial Correlation Coefficients';
|
||
|
|
DynVectorPrint(PartCors,maxlag,Title,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// plot correlations if elected
|
||
|
|
uplimit := 1.96 * (1.0 / sqrt(count));
|
||
|
|
lowlimit := -1.96 * (1.0 / sqrt(count));
|
||
|
|
if (PlotChk.Checked = true) then
|
||
|
|
begin
|
||
|
|
for i := 0 to maxlag do rxy[i] := correlations[0][i];
|
||
|
|
AutoPlotFrm.PlotPartCors := true;
|
||
|
|
AutoPlotFrm.PlotLimits := true;
|
||
|
|
AutoPlotFrm.correlations := rxy;
|
||
|
|
AutoPlotFrm.partcors := PartCors;
|
||
|
|
AutoPlotFrm.uplimit := uplimit;
|
||
|
|
AutoPlotFrm.lowlimit := lowlimit;
|
||
|
|
AutoPlotFrm.npoints := maxlag+1;
|
||
|
|
AutoPlotFrm.DepVarEdit := DepVarEdit.Text;
|
||
|
|
// AutoPlotFrm.AutoPlot;
|
||
|
|
AutoPlotFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if MRegSmoothChk.Checked then
|
||
|
|
begin
|
||
|
|
// calculate predicted values and residuals for remaining points
|
||
|
|
// Note - the dependent variable predicted is the next value in
|
||
|
|
// the time series using each of the previous time period values
|
||
|
|
// as predictors
|
||
|
|
for i := maxlag to (NoPts + noproj - 1) do
|
||
|
|
begin
|
||
|
|
Yhat := 0.0;
|
||
|
|
for j := 0 to maxlag do Yhat := Yhat + (betas[j] * pts[i-maxlag+j]);
|
||
|
|
Yhat := Yhat + Constant;
|
||
|
|
avg[i] := Yhat;
|
||
|
|
residual[i] := pts[i] - Yhat;
|
||
|
|
end;
|
||
|
|
// plot points smoothed by autoregression
|
||
|
|
avg[0] := pts[0];
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := avg;
|
||
|
|
PointsFrm.NoCases := NoPts + noproj;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Smoothed';
|
||
|
|
PointsFrm.Title := 'Autoregressive Smoothed';
|
||
|
|
PointsFrm.Caption := 'Autoregression Smoothing';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
|
||
|
|
// plot residuals if elected
|
||
|
|
if (ResidChk.Checked) then
|
||
|
|
begin
|
||
|
|
varresid := 0.0;
|
||
|
|
residual[0] := 0.0;
|
||
|
|
for i := 1 to maxlag do
|
||
|
|
begin
|
||
|
|
// residual[i] := pts[i] - avg[i];
|
||
|
|
varresid := varresid + (residual[i] * residual[i]);
|
||
|
|
end;
|
||
|
|
varresid := varresid / maxlag;
|
||
|
|
StdErr := sqrt(varresid);
|
||
|
|
// plot the residuals
|
||
|
|
PointsFrm.pts := pts;
|
||
|
|
PointsFrm.avg := residual;
|
||
|
|
PointsFrm.NoCases := NoPts;
|
||
|
|
Msg := 'Std. Err. Residuals = ';
|
||
|
|
Msg := Msg + FloatToStr(StdErr);
|
||
|
|
PointsFrm.MsgEdit.Text := Msg;
|
||
|
|
PointsFrm.LabelOne := 'Original';
|
||
|
|
PointsFrm.LabelTwo := 'Residuals';
|
||
|
|
PointsFrm.Title := 'Residuals from Autoregression Smoothing';
|
||
|
|
PointsFrm.Caption := 'Autoregressive Residuals';
|
||
|
|
PointsFrm.ShowModal;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// clean up the heap
|
||
|
|
residual := nil;
|
||
|
|
avg := nil;
|
||
|
|
pts := nil;
|
||
|
|
rxy := nil;
|
||
|
|
betas := nil;
|
||
|
|
a := nil;
|
||
|
|
PartCors := nil;
|
||
|
|
ColLabels := nil;
|
||
|
|
RowLabels := nil;
|
||
|
|
StdDevs := nil;
|
||
|
|
Means := nil;
|
||
|
|
correlations := nil;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.ColBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
VarList.Clear;
|
||
|
|
for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
GroupBox2.Caption := 'Include Cases:';
|
||
|
|
AllCasesBtn.Caption := 'All Cases';
|
||
|
|
OnlyCasesBtn.Caption := 'Only Cases From:';
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.InBtnClick(Sender: TObject);
|
||
|
|
VAR index : integer;
|
||
|
|
begin
|
||
|
|
index := VarList.ItemIndex;
|
||
|
|
DepVarEdit.Text := VarList.Items.Strings[index];
|
||
|
|
VarList.Items.Delete(index);
|
||
|
|
OutBtn.Visible := true;
|
||
|
|
InBtn.Visible := false;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.OutBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(DepVarEdit.Text);
|
||
|
|
DepVarEdit.Text := '';
|
||
|
|
InBtn.Visible := true;
|
||
|
|
OutBtn.Visible := false;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.four1(var data: DblDyneVec; nn: longword; isign: integer);
|
||
|
|
var
|
||
|
|
n,mmax,m,j,istep, i : longword;
|
||
|
|
wtemp,wr,wpr,wpi,wi,theta : double;
|
||
|
|
tempr,tempi : double;
|
||
|
|
|
||
|
|
begin
|
||
|
|
n := 2 * nn;
|
||
|
|
j := 1;
|
||
|
|
i := 1;
|
||
|
|
while i < n do
|
||
|
|
begin
|
||
|
|
if (j > i) then
|
||
|
|
begin
|
||
|
|
tempr := data[j];
|
||
|
|
tempi := data[j+1];
|
||
|
|
data[j] := data[i];
|
||
|
|
data[j+1] := data[i+1];
|
||
|
|
data[i] := tempr;
|
||
|
|
data[i+1] := tempi;
|
||
|
|
end;
|
||
|
|
m := n div 2;
|
||
|
|
while (m >= 2) and (j > m) do
|
||
|
|
begin
|
||
|
|
j := j - m;
|
||
|
|
m := m div 2;
|
||
|
|
end;
|
||
|
|
j := j + m;
|
||
|
|
i := i + 2;
|
||
|
|
end;
|
||
|
|
mmax := 2;
|
||
|
|
while (n > mmax) do
|
||
|
|
begin
|
||
|
|
istep := 2 * mmax;
|
||
|
|
theta := isign * (6.28318530717959 / mmax);
|
||
|
|
wtemp := sin(0.5 * theta);
|
||
|
|
wpr := -2.0 * wtemp * wtemp;
|
||
|
|
wpi := sin(theta);
|
||
|
|
wr := 1.0;
|
||
|
|
wi := 0.0;
|
||
|
|
m := 1;
|
||
|
|
while m < mmax do
|
||
|
|
begin
|
||
|
|
i := m;
|
||
|
|
while i <= n do
|
||
|
|
begin
|
||
|
|
j := i + mmax;
|
||
|
|
tempr := wr * data[j] - wi * data[j+1];
|
||
|
|
tempi := wr * data[j+1] + wi * data[j];
|
||
|
|
data[j] := data[i] - tempr;
|
||
|
|
data[j+1] := data[i+1] - tempi;
|
||
|
|
data[i] := data[i] + tempr;
|
||
|
|
data[i+1] := data[i+1] + tempi;
|
||
|
|
i := i + istep;
|
||
|
|
end;
|
||
|
|
wtemp := wr;
|
||
|
|
wr := wr * wpr - wi * wpi + wr;
|
||
|
|
wi := wi * wpr + wtemp * wpi + wi;
|
||
|
|
m := m + 2;
|
||
|
|
end;
|
||
|
|
mmax := istep;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.realft(var data: DblDyneVec; n: longword; isign: integer);
|
||
|
|
var
|
||
|
|
i,i1,i2,i3,i4,np3 : longword;
|
||
|
|
c1,c2,h1r,h1i,h2r,h2i : double;
|
||
|
|
wr,wi,wpr,wpi,wtemp,theta : double;
|
||
|
|
|
||
|
|
begin
|
||
|
|
c1 := 0.5;
|
||
|
|
theta := 3.141592653589793 / ( n div 2);
|
||
|
|
if (isign = 1) then
|
||
|
|
begin
|
||
|
|
c2 := -0.5;
|
||
|
|
four1(data,n div 2,1);
|
||
|
|
end else
|
||
|
|
begin
|
||
|
|
c2 := 0.5;
|
||
|
|
theta := -theta;
|
||
|
|
end;
|
||
|
|
wtemp := sin(0.5 * theta);
|
||
|
|
wpr := -2.0 * wtemp * wtemp;
|
||
|
|
wpi := sin(theta);
|
||
|
|
wr := 1.0 + wpr;
|
||
|
|
wi := wpi;
|
||
|
|
np3 := n + 3;
|
||
|
|
for i := 2 to n div 2 do
|
||
|
|
begin
|
||
|
|
i1 := i + i - 1;
|
||
|
|
i2 := 1 + i1;
|
||
|
|
i3 := np3 - i2;
|
||
|
|
i4 := 1 + i3;
|
||
|
|
h1r := c1 * (data[i1] + data[i3]);
|
||
|
|
h1i := c1 * (data[i2] - data[i4]);
|
||
|
|
h2r := -c2 * (data[i2] + data[i4]);
|
||
|
|
h2i := c2 * (data[i1] - data[i3]);
|
||
|
|
data[i1] := h1r + wr * h2r - wi * h2i;
|
||
|
|
data[i2] := h1i + wr * h2i + wi * h2r;
|
||
|
|
data[i3] := h1r - wr * h2r + wi * h2i;
|
||
|
|
data[i4] := -h1i + wr * h2i + wi * h2r;
|
||
|
|
wtemp := wr;
|
||
|
|
wr := wtemp * wpr - wi * wpi + wr;
|
||
|
|
wi := wi * wpr + wtemp * wpi + wi;
|
||
|
|
end;
|
||
|
|
if (isign = 1) then
|
||
|
|
begin
|
||
|
|
h1r := data[1];
|
||
|
|
data[1] := h1r + data[2];
|
||
|
|
data[2] := h1r - data[2];
|
||
|
|
end else
|
||
|
|
begin
|
||
|
|
h1r := data[1];
|
||
|
|
data[1] := c1 * (h1r + data[2]);
|
||
|
|
data[2] := c1 * (h1r - data[2]);
|
||
|
|
four1(data,n div 2,-1);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.fourier(var data: DblDyneVec; n: integer; npts: integer );
|
||
|
|
var
|
||
|
|
nmin, m, mo2, i, k, j : integer;
|
||
|
|
yn, y1, rn1, fac, cnst : double;
|
||
|
|
y : DblDyneVec;
|
||
|
|
|
||
|
|
begin
|
||
|
|
m := 2;
|
||
|
|
nmin := n + (2 * npts);
|
||
|
|
while (m < nmin) do m := m * 2;
|
||
|
|
cnst := npts / m;
|
||
|
|
cnst := cnst * cnst;
|
||
|
|
SetLength(y,m+1);
|
||
|
|
for i := 0 to n - 1 do y[i+1] := data[i];
|
||
|
|
y1 := y[1];
|
||
|
|
yn := y[n];
|
||
|
|
rn1 := 1.0 / (n - 1);
|
||
|
|
for j := 1 to n do y[j] := y[j] + (-rn1 * (y1 * (n - j) + y1 * (j - 1)));
|
||
|
|
for j := n+1 to m do y[j] := 0.0;
|
||
|
|
mo2 := m div 2;
|
||
|
|
realft(y,mo2,1);
|
||
|
|
y[1] := y[1] / mo2;
|
||
|
|
fac := 1.0;
|
||
|
|
for j := 1 to mo2 - 1 do
|
||
|
|
begin
|
||
|
|
k := 2 * j + 1;
|
||
|
|
if (fac <> 0) then
|
||
|
|
begin
|
||
|
|
fac := (1.0 - cnst * j * j) / mo2;
|
||
|
|
if ( fac < 0.0) then fac := 0.0;
|
||
|
|
y[k] := fac * y[k];
|
||
|
|
y[k + 1] := fac * y[k + 1];
|
||
|
|
end
|
||
|
|
else y[k + 1] := 0.0;
|
||
|
|
y[k] := 0.0;
|
||
|
|
end;
|
||
|
|
fac := (1.0 - 0.25 * npts * npts) / mo2;
|
||
|
|
if (fac < 0.0) then fac := 0.0;
|
||
|
|
y[2] := y[2] * fac;
|
||
|
|
realft(y,mo2,-1);
|
||
|
|
for j := 1 to n do y[j] := y[j] + rn1 * (y1 * (n - j) + yn * (j - 1));
|
||
|
|
for j := 0 to n - 1 do data[j] := y[j+1];
|
||
|
|
y := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TAutocorrFrm.PolyFit(var pts: DblDyneVec; var avg: DblDyneVec;
|
||
|
|
NoPts: integer);
|
||
|
|
var
|
||
|
|
X : DblDyneMat;
|
||
|
|
XY : DblDyneVec;
|
||
|
|
XTX : DblDyneMat;
|
||
|
|
Beta : DblDyneVec;
|
||
|
|
t, Yhat : double;
|
||
|
|
i, j, k, order : integer;
|
||
|
|
RowLabels, ColLabels : StrDyneVec;
|
||
|
|
|
||
|
|
begin
|
||
|
|
order := StrToInt(PolynomialFrm.PolyEdit.Text);
|
||
|
|
SetLength(X,NoPts,order+1);
|
||
|
|
SetLength(XTX,order+2,order+2);
|
||
|
|
SetLength(XY,order+1);
|
||
|
|
SetLength(Beta,order+1);
|
||
|
|
SetLength(RowLabels,NoPts+1);
|
||
|
|
SetLength(ColLabels,NoPts+1);
|
||
|
|
|
||
|
|
// initialize
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
X[i,j] := 0.0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
for i := 0 to order do
|
||
|
|
begin
|
||
|
|
XY[i] := 0.0;
|
||
|
|
Beta[i] := 0.0;
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
XTX[i,j] := 0.0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
t := i+1;
|
||
|
|
X[i,j] := Power(t,j);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// print the X matrix as a check
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
RowLabels[i] := 'Case' + IntToStr(i+1);
|
||
|
|
end;
|
||
|
|
for i := 0 to order+1 do
|
||
|
|
begin
|
||
|
|
ColLabels[i] := 'Order' + IntToStr(i);
|
||
|
|
end;
|
||
|
|
{
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'X Matrix';
|
||
|
|
DynMatPrint(X,NoPts,order+1,Title,RowLabels,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
}
|
||
|
|
// Get X transpose times X
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
for k := 0 to order do
|
||
|
|
begin
|
||
|
|
XTX[j,k] := 0.0;
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
XTX[j,k] := XTX[j,k] + (X[i,j] * X[i,k]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{
|
||
|
|
// print the XTX matrix
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'XTX Matrix (Offset by 1)';
|
||
|
|
DynMatPrint(XTX,order+2,order+2,Title,ColLabels,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
}
|
||
|
|
// Get X transpose Y
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
XY[j] := XY[j] + (X[i,j] * pts[i]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{
|
||
|
|
// print the XY vector
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'XY vector';
|
||
|
|
DynVectorPrint(XY,order+1,Title,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
}
|
||
|
|
// get inverse of XTX
|
||
|
|
SVDinverse(XTX,order+1);
|
||
|
|
{
|
||
|
|
// print the inverse matrix
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'XTX Inverse Matrix';
|
||
|
|
DynMatPrint(XTX,order+2,order+2,Title,ColLabels,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
}
|
||
|
|
// get betas
|
||
|
|
for j := 0 to order do
|
||
|
|
begin
|
||
|
|
for k := 0 to order do
|
||
|
|
begin
|
||
|
|
Beta[j] := Beta[j] + (XTX[j,k] * XY[k]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
{
|
||
|
|
// print the betas
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
Title := 'Betas vector';
|
||
|
|
DynVectorPrint(Beta,order+1,Title,ColLabels,NoPts);
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
}
|
||
|
|
// get predicted values
|
||
|
|
for i := 0 to NoPts - 1 do
|
||
|
|
begin
|
||
|
|
Yhat := 0.0;
|
||
|
|
t := i;
|
||
|
|
for j := 0 to order do Yhat := Yhat + (Beta[j] * Power(t,j));
|
||
|
|
avg[i] := Yhat;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//cleanup
|
||
|
|
ColLabels := nil;
|
||
|
|
RowLabels := nil;
|
||
|
|
Beta := nil;
|
||
|
|
XY := nil;
|
||
|
|
XTX := nil;
|
||
|
|
X := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I autocorunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|