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.