unit WLSUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, Globals, MainUnit, DictionaryUnit, Matrixlib, DataProcs, BlankFrmUnit, ReportFrameUnit, ChartFrameUnit, BasicStatsParamsFormUnit; //BasicStatsReportAndChartFormUnit; type { TWLSFrm } TWLSFrm = class(TBasicStatsParamsForm) //TBasicStatsReportAndChartForm) DepInBtn: TBitBtn; DepOutBtn: TBitBtn; IndInBtn: TBitBtn; IndOutBtn: TBitBtn; PageControl: TPageControl; OLSPage: TTabSheet; ResRegPageControl: TPageControl; ResidualsRegPage: TTabSheet; ResRegReportPage: TTabSheet; WLSPage: TTabSheet; WghtInBtn: TBitBtn; WghtOutBtn: TBitBtn; OLSChk: TCheckBox; PlotChk: TCheckBox; RegResChk: TCheckBox; SaveChk: TCheckBox; WeightChk: TCheckBox; OriginChk: TCheckBox; UserWghtsChk: TCheckBox; Origin2Chk: TCheckBox; DepVarEdit: TEdit; WghtVarEdit: TEdit; OptionsGroup: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; IndVarList: TListBox; VarList: TListBox; procedure DepInBtnClick(Sender: TObject); procedure DepOutBtnClick(Sender: TObject); procedure IndInBtnClick(Sender: TObject); procedure IndOutBtnClick(Sender: TObject); procedure IndVarListDblClick(Sender: TObject); procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; User: boolean); procedure WghtInBtnClick(Sender: TObject); procedure WghtOutBtnClick(Sender: TObject); private OLSReportFrame: TReportFrame; ResidualsRegReportFrame: TReportFrame; WLSReportFrame: TReportFrame; procedure CreateOrGetChartFrame(AColIndex: Integer; AVarName: String; out AMemo: TMemo; out AChartFrame: TChartFrame); function GetPageCaption(AVarName: String): String; procedure PredictIt(ColNoSelected: IntDyneVec; NoVars: integer; Means, StdDevs, BetaWeights: DblDyneVec; StdErrEst: double; NoIndepVars: integer); procedure PlotXY(AChartFrame: TChartFrame; const XPoints, YPoints, UpConf, LowConf: DblDyneVec; ConfBand, XMean, YMean, R, Slope, Intercept: Double; XLabel, YLabel: String); procedure PlotXY(Xpoints, Ypoints, UpConf, LowConf: DblDyneVec; ConfBand, Xmean, Ymean, R, Slope, Intercept: double; Xmax, Xmin, Ymax, Ymin: double; N: integer; XLabel, YLabel: string); protected procedure AdjustConstraints; override; procedure Compute; override; procedure UpdateBtnStates; override; function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override; public constructor Create(AOwner: TComponent); override; procedure Reset; override; end; var WLSFrm: TWLSFrm; implementation {$R *.lfm} uses TAChartUtils, TALegend, Utils, GridProcs, MathUnit; { TWLSFrm } constructor TWLSFrm.Create(AOwner: TComponent); begin inherited; if BlankFrm = nil then Application.CreateForm(TBlankFrm, BlankFrm); if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm); OLSReportFrame := TReportFrame.Create(self); OLSReportFrame.Name := ''; OLSReportFrame.Parent := OLSPage; OLSReportFrame.Align := alClient; OLSReportFrame.BorderSpacing.Left := 0; OLSReportFrame.BorderSpacing.Top := 0; OLSReportFrame.BorderSpacing.Bottom := 0; OLSReportFrame.BorderSpacing.Right := 0; InitToolbar(OLSReportFrame.ReportToolbar, tpRight); ResidualsRegReportFrame := TReportFrame.Create(self); ResidualsRegReportFrame.Name := ''; ResidualsRegReportFrame.Parent := ResRegReportPage; ResidualsRegReportFrame.Align := alClient; ResidualsRegReportFrame.BorderSpacing.Left := 0; ResidualsRegReportFrame.BorderSpacing.Top := 0; ResidualsRegReportFrame.BorderSpacing.Bottom := 0; ResidualsRegReportFrame.BorderSpacing.Right := 0; InitToolbar(ResidualsRegReportFrame.ReportToolbar, tpRight); WLSReportFrame := TReportFrame.Create(self); WLSReportFrame.Name := ''; WLSReportFrame.Parent := WLSPage; WLSReportFrame.Align := alClient; WLSReportFrame.BorderSpacing.Left := 0; WLSReportFrame.BorderSpacing.Top := 0; WLSReportFrame.BorderSpacing.Bottom := 0; WLSReportFrame.BorderSpacing.Right := 0; InitToolbar(WLSReportFrame.ReportToolbar, tpRight); end; procedure TWLSFrm.AdjustConstraints; begin ParamsPanel.Constraints.MinHeight := DepInBtn.Top + (IndOutBtn.Top - DepInBtn.Top)*2 + DepInBtn.Top + OptionsGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; ParamsPanel.Constraints.MinWidth := OptionsGroup.Width; end; procedure TWLSFrm.Compute; var i, ii, j, Noindep, DepCol, WghtCol, olddepcol, NCases, pos, col: integer; IndepCols: IntDyneVec = nil; RowLabels: StrDyneVec = nil; X, Y: double; Means: DblDyneVec = nil; Variances: DblDyneVec = nil; StdDevs: DblDyneVec = nil; BWeights: DblDyneVec = nil; BetaWeights: DblDyneVec = nil; BStdErrs: DblDyneVec = nil; BtTests: DblDyneVec = nil; tProbs: DblDyneVec = nil; PrintDesc: boolean = true; Xpoints: DblDyneVec = nil; Ypoints: DblDyneVec = nil; upConf: DblDyneVec = nil; lowConf: DblDyneVec = nil; Xmax, Xmin, Ymax, Ymin, Xmean, Ymean, Xvariance, Yvariance, R: double; temp, SEPred, Slope, Intercept, DF, SSx, t, ConfBand, sedata: double; Xstddev, Ystddev, predicted: double; ColNoSelected: IntDyneVec = nil; XLabel, YLabel: string; N, Xcol, Ycol, NoSelected: integer; lReport: TStrings; StdErrEst: Double = 0.0; R2: Double = 0.0; errorcode: Boolean = false; C: TWinControl; msg: String; chartFrame: TChartFrame; memo: TMemo; begin if not Validate(msg, C) then begin C.SetFocus; ErrorMsg(msg); exit; end; PrintDesc := true; SetLength(Means, NoVariables + 2); SetLength(Variances, NoVariables + 2); SetLength(StdDevs, NoVariables + 2); SetLength(BWeights, NoVariables + 2); SetLength(BetaWeights, NoVariables + 2); SetLength(BStdErrs, NoVariables + 2); SetLength(Bttests, NoVariables + 2); SetLength(tprobs, NoVariables + 2); SetLength(RowLabels, NoVariables + 2); SetLength(IndepCols, NoVariables + 2); // SetLength(Xpoints, NoCases + 1); // SetLength(Ypoints, NoCases + 1); // SetLength(UpConf, NoCases + 1); // SetLength(lowConf, NoCases + 1); SetLength(ColNoSelected, 2); lReport := TStringList.Create; try NCases := NoCases; NoIndep := IndVarList.Items.Count; // wp: This SetLength crashes... // SetLength(IndepCols, NoIndep+1); // +1 because the dep col will be stuffed in there, too // SetLength(RowLabels, NoIndep); depCol := GetVariableIndex(OS3MainFrm.DataGrid, DepVarEdit.Text); wghtCol := GetVariableIndex(OS3MainFrm.DataGrid, WghtVarEdit.Text); for i := 0 to NoIndep-1 do begin IndepCols[i] := GetVariableIndex(OS3MainFrm.DataGrid, IndVarList.Items[i]); if IndepCols[i] = -1 then begin ErrorMsg('Dependent variable %s not found.', [IndVarList.Items[i]]); exit; end; RowLabels[i] := IndVarList.Items[i]; end; { WghtCol := 0; for i := 0 to NoVariables - 1 do begin if (OS3MainFrm.DataGrid.Cells[i+1,0] = DepVarEdit.Text) then DepCol := i+1; if (OS3MainFrm.DataGrid.Cells[i+1,0] = WghtVarEdit.Text) then WghtCol := i+1; for j := 0 to Noindep - 1 do begin if (OS3MainFrm.DataGrid.Cells[i+1,0] = IndVarList.Items.Strings[j]) then begin IndepCols[j] := i+1; RowLabels[j] := IndVarList.Items.Strings[j]; end; end; // next j end; // next i if (DepCol = 0) then begin ErrorMsg('No dependent variable selected.'); exit; end; } { wp: I think this is not correct: The column index is the last one in this call. And why is row 0 checked? // check variable types if not ValidValue(OS3MainFrm.DataGrid, DepCol, 0) then begin ErrorMsg('Incorrect dependent variable type.'); exit; end; if (WghtCol > -1) then begin if not ValidValue(OS3MainFrm.DataGrid, WghtCol, 0) then begin ErrorMsg('Incorrect weight variable type.'); exit; end; end; for j := 0 to Noindep - 1 do begin if not ValidValue(OS3MainFrm.DataGrid, IndepCols[j],0) then begin ErrorMsg('Incorrect dependent variable type.'); exit; end; end; } IndepCols[NoIndep] := depCol; oldDepCol := DepCol; // save dependent column so we can reuse DepCol // Get OLS regression if OLSChk.Checked then begin lReport.Clear; lReport.Add('ORDINARY LEAST SQUARES (OLS) REGRESSION RESULTS'); lReport.Add(''); MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc, lReport); // Get predicted z score, residual z score, predicted raw score, // residual raw score and squared raw residual score. Place in the DataGrid PredictIt(IndepCols, Noindep+1, Means, StdDevs, BetaWeights, stderrest, NoIndep); OLSReportFrame.DisplayReport(lReport); lReport.Clear; { lReport.Add(''); lReport.Add(DIVIDER); lReport.Add(''); } end; if RegResChk.Checked and OLSChk.Checked then begin // Regress the squared residuals on the predictors depCol := NoVariables; lReport.Clear; lReport.Add('REGRESSION OF SQUARED RESIDUALS ON INDEPENDENT VARIABLES'); lReport.Add(''); MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc, lReport); ResidualsRegReportFrame.DisplayReport(lReport); lReport.Clear; { lReport.Add(DIVIDER); lReport.Add(''); } // FReportFrame.DisplayReport(lReport); // lReport.Clear; end; if WeightChk.Checked and RegResChk.Checked then begin // Get predicted squared residuals and save recipricols as weights col := NoVariables + 1; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.NewVar(col); DictionaryFrm.DictGrid.Cells[1,col] := 'PredResid2'; OS3MainFrm.DataGrid.Cells[col,0] := 'PredResid2'; col := NoVariables + 1; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.NewVar(col); DictionaryFrm.DictGrid.Cells[1,col] := 'WEIGHT'; OS3MainFrm.DataGrid.Cells[col,0] := 'WEIGHT'; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); for i := 1 to NoCases do begin if (DataProcs.ValidValue(i, col-2)) then // do we have a valid squared OLS residual? begin predicted := 0.0; for j := 0 to NoIndep - 1 do begin pos := IndepCols[j]; X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); predicted := predicted + BWeights[j] * X; end; predicted := predicted + BWeights[Noindep]; predicted := abs(predicted); OS3MainFrm.DataGrid.Cells[col-1,i] := Format('%.3f', [predicted]); if (predicted > 0.0) then predicted := 1.0 / sqrt(predicted) else predicted := 0.0; OS3MainFrm.DataGrid.Cells[col,i] := Format('%.3f', [predicted]); end; // if valid case end; // next i end; // if regresChk // Now, plot squared residuals against each independent variable if RegResChk.Checked then begin xCol := DepCol; for ii := 0 to NoIndep - 1 do begin SetLength(xPoints, NoCases); SetLength(yPoints, NoCases); yCol := IndepCols[ii]; N := 0; ColNoSelected[0] := xCol; ColNoSelected[1] := yCol; NoSelected := 2; XLabel := OS3MainFrm.DataGrid.Cells[Xcol,0]; YLabel := OS3MainFrm.DataGrid.Cells[Ycol,0]; Xmax := -1.0e308; Xmin := 1.0e308; Ymax := -1.0e308; Ymin := 1.0e308; Xmean := 0.0; Ymean := 0.0; Xvariance := 0.0; Yvariance := 0.0; R := 0.0; for i := 1 to NoCases do begin if (not DataProcs.GoodRecord(i,NoSelected,ColNoSelected)) then continue; X := StrToFloat(OS3MainFrm.DataGrid.Cells[Xcol,i]); Y := StrToFloat(OS3MainFrm.DataGrid.Cells[Ycol,i]); Xpoints[N] := X; Ypoints[N] := Y; if (X > Xmax) then Xmax := X; if (X < Xmin) then Xmin := X; if (Y > Ymax) then Ymax := Y; if (Y < Ymin) then Ymin := Y; Xmean := Xmean + X; Ymean := Ymean + Y; Xvariance := Xvariance + X * X; Yvariance := Yvariance + Y * Y; R := R + X * Y; N := N + 1; end; SetLength(xPoints, N); SetLength(yPoints, N); // sort on X SortOnX(xPoints, yPoints); // calculate statistics Xvariance := Xvariance - Xmean * Xmean / N; SSx := Xvariance; Xvariance := Xvariance / (N - 1); Xstddev := sqrt(Xvariance); Yvariance := Yvariance - Ymean * Ymean / N; Yvariance := Yvariance / (N - 1); Ystddev := sqrt(Yvariance); R := R - Xmean * Ymean / N; R := R / (N - 1); R := R / (Xstddev * Ystddev); SEPred := sqrt(1.0 - R * R) * Ystddev; SEPred := SEPred * sqrt((N - 1) / (N - 2)); Xmean := Xmean / N; Ymean := Ymean / N; Slope := R * Ystddev / Xstddev; Intercept := Ymean - Slope * Xmean; // Now, print the descriptive statistics if requested lReport.Clear; lReport.Add('Data file: %s', [OS3MainFrm.FileNameEdit.Text]); lReport.Add(''); lReport.Add('Variables:'); lReport.Add(' X: %s', [OS3MainFrm.DataGrid.Cells[xCol, 0]]); lReport.Add(' Y: %s', [OS3MainFrm.DataGrid.Cells[yCol, 0]]); lReport.Add(''); lReport.Add('Variable Mean Variance Std.Dev.'); lReport.Add('---------- -------- -------- --------'); lReport.Add('%-10s %8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[xCol, 0], XMean, XVariance, XStdDev]); lReport.Add('%-10s %8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[ycol, 0], YMean, YVariance, YStdDev]); lReport.Add(''); lReport.Add('Correlation: %8.4f', [R]); lReport.Add('Slope: %8.2f', [Slope]); lReport.Add('Intercept: %8.2f', [Intercept]); lReport.Add('Standard Error of Estimate: %8.2f', [SEPred]); lReport.Add('Number of good cases: %8d', [N]); // Get upper and lower confidence points for each X value SetLength(UpConf, N); SetLength(LowConf, N); ConfBand := 0.95; DF := N - 2; t := inverset(ConfBand,DF); for i := 0 to N-1 do begin X := Xpoints[i]; predicted := Slope * X + Intercept; sedata := SEPred * sqrt(1.0 + (1.0 / N) + ((X - Xmean) * (X - Xmean) / SSx)); UpConf[i] := predicted + (t * sedata); lowConf[i] := predicted - (t * sedata); if (UpConf[i] > Ymax) then Ymax := UpConf[i]; if (lowConf[i] < Ymin) then Ymin := lowConf[i]; end; // Plot the values, line and confidence band CreateOrGetChartFrame(yCol, yLabel, memo, chartFrame); chartFrame.Clear; PlotXY(chartFrame, XPoints, YPoints, upConf, lowConf, confBand, xMean, yMean, R, slope, intercept, xLabel, yLabel); memo.Lines.Assign(lReport); lReport.Clear; { if NormPltChk.Checked then PlotNormalDist(chartFrame, normDistValue); PlotFreq(chartFrame, col, cellVal, xLabels, freq); } if PlotChk.Checked then begin PlotXY(Xpoints, Ypoints, UpConf, lowConf, ConfBand, Xmean, Ymean, R, Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N, XLabel, YLabel); BlankFrm.ShowModal; end; end; // FReportFrame.DisplayReport(lReport); end; if not UserWghtsChk.Checked then begin // Weight variables and do OLS regression on weighted variables DepCol := olddepcol; IndepCols[Noindep] := DepCol; for i := 1 to NoCases do begin Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[NoVariables,i])); // weight for j := 0 to Noindep do begin pos := IndepCols[j]; X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); X := X * Y; OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); end; end; // get means of variables and subtract from the values if OriginChk.Checked then begin for j := 0 to Noindep do begin Means[j] := 0.0; NCases := 0; pos := IndepCols[j]; for i := 1 to NoCases do begin if (DataProcs.ValidValue(i,pos)) then begin Means[j] := Means[j] + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); NCases := NCases + 1; end; end; Means[j] := Means[j] / NCases; for i := 1 to NoCases do begin if (DataProcs.ValidValue(i,pos)) then begin X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); X := X - Means[j]; OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); end; end; // next i end; // next j end; // if origin checked lReport.Clear; lReport.Add('WEIGHTED LEAST SQUARES (WLS) REGRESSION RESULTS'); lReport.Add(''); MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc, lReport); WLSReportFrame.DisplayReport(lReport); lReport.Clear; end // if useweightschk checked else // use the weights entered by the user if (UserWghtsChk.Checked) then begin // Weight variables and do OLS regression on weighted variables DepCol := olddepcol; IndepCols[Noindep] := DepCol; for i := 1 to NoCases do begin Y := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[WghtCol,i])); // weight for j := 0 to Noindep do begin pos := IndepCols[j]; X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); X := X * Y; OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); end; end; if (OriginChk.Checked) then // get means of variables and subtract from the values begin for j := 0 to Noindep do begin Means[j] := 0.0; NCases := 0; pos := IndepCols[j]; for i := 1 to NoCases do begin if (DataProcs.ValidValue(i,pos)) then begin Means[j] := Means[j] + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[pos,i])); NCases := NCases + 1; end; end; Means[j] := Means[j] / NCases; for i := 1 to NoCases do begin if (DataProcs.ValidValue(i,pos)) then begin X := StrToFloat(OS3MainFrm.DataGrid.Cells[pos,i]); X := X - Means[j]; OS3MainFrm.DataGrid.Cells[pos,i] := FloatToStr(X); end; end; // next i end; // next j end; // if origin checked lReport.Clear; lReport.Add('WEIGHTED LEAST SQUARES (WLS) REGRESSION RESULTS'); lReport.Add(''); MReg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc, lReport); WLSReportFrame.DisplayReport(lReport); lReport.Clear; end; finally lReport.Free; end; end; procedure TWLSFrm.CreateOrGetChartFrame(AColIndex: Integer; AVarName: String; out AMemo: TMemo; out AChartFrame: TChartFrame); var sheetTitle: String; tabSheet: TTabSheet; i: Integer; begin sheetTitle := GetPageCaption(AVarName); // Find existing sheet first. for i := 1 to ResRegPageControl.PageCount-1 do if ResRegPageControl.Pages[i].Caption = sheetTitle then begin tabSheet := ResRegPageControl.Pages[i]; AChartFrame := tabSheet.Controls[0] as TChartFrame; AMemo := tabSheet.Controls[1] as TMemo; exit; end; // Not found: create new sheet ... tabSheet := ResRegPageControl.AddTabSheet; tabSheet.Caption := sheetTitle; tabSheet.Tag := AColIndex; // ... and add ChartFrame AChartFrame := TChartFrame.Create(tabSheet); AChartFrame.Parent := tabSheet; AChartFrame.Align := alClient; AChartFrame.Chart.Legend.Alignment := laBottomCenter; AChartFrame.Chart.Legend.ColumnCount := 3; AChartFrame.Chart.Legend.TextFormat := tfHTML; AChartFrame.Chart.BottomAxis.Intervals.MaxLength := 80; AChartFrame.Chart.BottomAxis.Intervals.MinLength := 30; // ... and add memo AMemo := TMemo.Create(tabSheet); AMemo.Parent := tabSheet; AMemo.Align := alBottom; AMemo.BorderStyle := bsNone; AMemo.Font.Name := 'Courier New'; AMemo.Font.Size := 8; AMemo.ReadOnly := true; AMemo.Scrollbars := ssAutoBoth; AMemo.WordWrap := false; // ... and splitter with TSplitter.Create(tabSheet) do begin Parent := tabSheet; Align := alBottom; end; end; procedure TWLSFrm.DepInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (DepVarEdit.Text = '') then begin DepVarEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); UpdateBtnStates; end; end; procedure TWLSFrm.DepOutBtnClick(Sender: TObject); begin if (DepVarEdit.Text <> '') then begin VarList.Items.Add(DepVarEdit.Text); DepVarEdit.Text := ''; UpdateBtnStates; end; end; function TWLSFrm.GetPageCaption(AVarName: String): String; begin Result := 'Plot of ' + AVarName; end; procedure TWLSFrm.IndInBtnClick(Sender: TObject); var i: integer; begin i := 0; while (i < VarList.Items.Count) do begin if (VarList.Selected[i]) then begin IndVarList.Items.Add(VarList.Items[i]); VarList.Items.Delete(i); i := 0; end else inc(i); end; UpdateBtnStates; end; procedure TWLSFrm.IndOutBtnClick(Sender: TObject); var i: integer; begin i := 0; while (i < IndVarList.Items.Count) do begin if IndVarlist.Selected[i] then begin VarList.Items.Add(IndVarList.Items[i]); IndVarlist.Items.Delete(i); i := 0; end else inc(i); end; UpdateBtnStates; end; procedure TWLSFrm.IndVarListDblClick(Sender: TObject); var index: Integer; begin index := IndVarList.ItemIndex; if index > -1 then begin VarList.Items.Add(IndVarList.Items[index]); IndVarlist.Items.Delete(index); UpdateBtnStates; end; end; { Routine obtains predicted raw and standardized scores and their residuals. It is assumed that the dependent variable is last in the list of variable column pointers stored in the ColNoSelected vector. Get the z predicted score and its residual } procedure TWLSFrm.PredictIt(ColNoSelected: IntDyneVec; NoVars: integer; Means, StdDevs, BetaWeights: DblDyneVec; StdErrEst: double; NoIndepVars: integer); var col, i, j, k, Index: integer; predicted, zpredicted, z1, z2, resid, residsqr: double; begin col := NoVariables + 1; // NoVariables := col; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.DictGrid.ColCount := 8; DictionaryFrm.NewVar(col); OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.z'; DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.z'; col := NoVariables + 1; // NoVariables := col; DictionaryFrm.NewVar(col); OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); OS3MainFrm.DataGrid.Cells[col,0] := 'z Resid.'; DictionaryFrm.DictGrid.Cells[1,col] := 'z Resid.'; OS3MainFrm.DataGrid.ColCount := OS3MainFrm.DataGrid.ColCount + 2; for i := 1 to NoCases do begin zpredicted := 0.0; for j := 0 to NoIndepVars - 1 do begin k := ColNoSelected[j]; z1 := (StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]) - Means[j]) / StdDevs[j]; zpredicted := zpredicted + (z1 * BetaWeights[j]); end; OS3MainFrm.DataGrid.Cells[col-1,i] := Format('%.4f',[zpredicted]); if StdDevs[NoVars-1] <> 0.0 then begin Index := ColNoSelected[NoVars-1]; z2 := StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; // z score OS3MainFrm.DataGrid.Cells[col,i] := Format('%.4f',[z2 - zpredicted]); // z residual end; end; // Get raw predicted and residuals col := NoVariables + 1; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.NewVar(col); DictionaryFrm.DictGrid.Cells[1,col] := 'Pred.Raw'; OS3MainFrm.DataGrid.Cells[col,0] := 'Pred.Raw'; // calculate raw predicted scores and store in DataGrid at col for i := 1 to NoCases do begin // predicted raw obtained from previously predicted z score predicted := StrToFloat(OS3MainFrm.DataGrid.Cells[col-2,i]) * StdDevs[NoVars-1] + Means[NoVars-1]; OS3MainFrm.DataGrid.Cells[col,i] := Format('%.3f',[predicted]); end; // Calculate residuals of predicted raw scores end; col := NoVariables +1; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.NewVar(col); DictionaryFrm.DictGrid.Cells[1,col] := 'Raw Resid.'; OS3MainFrm.DataGrid.Cells[col,0] := 'Raw Resid.'; for i := 1 to NoCases do begin Index := ColNoSelected[NoVars-1]; resid := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]) - StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); OS3MainFrm.DataGrid.Cells[col,i] := Format('%.3f',[resid]); end; // get square of raw residuals col := NoVariables + 1; DictionaryFrm.NewVar(col); OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.DictGrid.Cells[1,col] := 'ResidSqr'; OS3MainFrm.DataGrid.Cells[col,0] := 'ResidSqr'; for i := 1 to NoCases do begin residsqr := StrToFloat(OS3MainFrm.DataGrid.Cells[col-1,i]); residsqr := residsqr * residsqr; OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.3f',[residsqr]); end; end; procedure TWLSFrm.PlotXY(AChartFrame: TChartFrame; const XPoints, YPoints, UpConf, LowConf: DblDyneVec; ConfBand, XMean, YMean, R, Slope, Intercept: Double; XLabel, YLabel: String); var xpts: DblDyneVec = nil; ypts: DblDyneVec = nil; ext: TDoubleRect; begin AChartFrame.SetFooter(Format('R(X,Y) = %.3f, Slope = %.3f, Intercept = %.3f', [ R, Slope, Intercept ])); // Data points AChartFrame.SetXTitle(XLabel); AChartFrame.SetYTitle(YLabel); AChartFrame.PlotXY(ptSymbols, XPoints, YPoints, nil, nil, 'Data', DATA_COLORS[0]); // Regression line SetLength(xpts, 2); SetLengtH(ypts, 2); ext := AChartFrame.Chart.GetFullExtent; xpts[0] := ext.a.x; xpts[0] := ext.b.x; ypts[0] := Intercept + Slope * xpts[0]; ypts[1] := Intercept + Slope * xpts[1]; AChartFrame.PlotXY(ptLines, xpts, ypts, nil, nil, 'Predicted', clBlack); // Upper and lower confidence limit curves AChartFrame.PlotXY(ptLines, XPoints, UpConf, nil, nil, 'UCL', clRed); AChartFrame.PlotXY(ptLines, XPoints, LowConf, nil, nil, 'LCL', clRed); // Mean lines AChartFrame.VertLine(XMean, clGreen, psDashDot, 'Mean ' + XLabel); // topLabels.Add(XMean, XMean, 'Mean ' + XLabel); AChartFrame.HorLine(YMean, clGreen, psDash, 'Mean ' + YLabel); // rightLabels.Add(YMean, YMean, 'Mean ' + YLabel); end; procedure TWLSFrm.PlotXY(Xpoints, Ypoints, UpConf, LowConf : DblDyneVec; ConfBand, Xmean, Ymean, R, Slope, Intercept : double; Xmax, Xmin, Ymax, Ymin : double; N : integer; XLabel, YLabel : string); VAR i, xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer; vhi, hwide, offset, strhi, imagehi : integer; valincr, Yvalue, Xvalue, value : double; Title, outline : string; begin BlankFrm.Image1.Canvas.Clear; Title := 'X versus Y PLOT Using File: ' + OS3MainFrm.FileNameEdit.Text; BlankFrm.Caption := Title; imagewide := BlankFrm.Image1.Width; imagehi := BlankFrm.Image1.Height; BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Brush.Color := clWhite; BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder); vtop := 20; vbottom := round(imagehi) - 80; vhi := vbottom - vtop; hleft := 100; hright := imagewide - 80; hwide := hright - hleft; BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.Brush.Color := clWhite; // Draw chart border BlankFrm.Image1.Canvas.Rectangle(0,0,imagewide,imagehi); // draw Means ypos := round(vhi * ( (Ymax - Ymean) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); xpos := hright; BlankFrm.Image1.Canvas.Pen.Color := clGreen; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); Title := 'MEAN '; Title := Title + YLabel; strhi := BlankFrm.Image1.Canvas.TextHeight(Title); ypos := ypos - strhi div 2; BlankFrm.Image1.Canvas.Brush.Color := clWhite; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); xpos := round(hwide * ( (Xmean - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; ypos := vtop; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := vbottom; BlankFrm.Image1.Canvas.Pen.Color := clGreen; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); Title := 'MEAN '; Title := Title + XLabel; strhi := BlankFrm.Image1.Canvas.TextWidth(Title); xpos := xpos - strhi div 2; ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title); BlankFrm.Image1.Canvas.Brush.Color := clWhite; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); // draw slope line BlankFrm.Image1.Canvas.Pen.Color := clBlack; Yvalue := (Xpoints[1] * Slope) + Intercept; // predicted score ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[1]- Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); Yvalue := (Xpoints[N] * Slope) + Intercept; // predicted score ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[N] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); // draw horizontal axis BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.MoveTo(hleft,vbottom); BlankFrm.Image1.Canvas.LineTo(hright,vbottom); valincr := (Xmax - Xmin) / 10.0; for i := 1 to 11 do begin ypos := vbottom; Xvalue := Xmin + valincr * (i - 1); xpos := round(hwide * ((Xvalue - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := ypos + 10; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); outline := format('%6.2f',[Xvalue]); Title := outline; offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2; xpos := xpos - offset; BlankFrm.Image1.Canvas.Pen.Color := clBlack; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); end; xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(XLabel) div 2); ypos := vbottom + 20; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XLabel); outline := format('R(X,Y) := %5.3f, Slope := %6.2f, Intercept := %6.2f', [R,Slope,Intercept]); Title := outline; xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(Title) div 2); ypos := ypos + 15; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); // Draw vertical axis Title := YLabel; // xpos := hleft - 10 - BlankFrm.Image1.Canvas.TextWidth(Title) / 2; xpos := 10; ypos := vtop - 8 - BlankFrm.Image1.Canvas.TextHeight(Title); BlankFrm.Image1.Canvas.TextOut(xpos,ypos,YLabel); xpos := hleft; ypos := vtop; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); ypos := vbottom; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); valincr := (Ymax - Ymin) / 10.0; for i := 1 to 11 do begin value := Ymax - ((i-1) * valincr); outline := format('%8.2f',[value]); Title := outline; strhi := BlankFrm.Image1.Canvas.TextHeight(Title); xpos := 10; Yvalue := Ymax - (valincr * (i-1)); ypos := round(vhi * ( (Ymax - Yvalue) / (Ymax - Ymin))); ypos := ypos + vtop - strhi div 2; BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title); xpos := hleft; ypos := ypos + strhi div 2; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); xpos := hleft - 10; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); end; // draw points for x and y pairs for i := 0 to N-1 do begin ypos := round(vhi * ( (Ymax - Ypoints[i]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.Brush.Color := clNavy; BlankFrm.Image1.Canvas.Brush.Style := bsSolid; BlankFrm.Image1.Canvas.Pen.Color := clNavy; BlankFrm.Image1.Canvas.Ellipse(xpos,ypos,xpos+5,ypos+5); end; // draw confidence bands if requested if not (ConfBand = 0.0) then begin BlankFrm.Image1.Canvas.Pen.Color := clRed; ypos := round(vhi * ((Ymax - UpConf[0]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[0] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); for i := 1 to N-1 do begin ypos := round(vhi * ((Ymax - UpConf[i]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); end; ypos := round(vhi * ((Ymax - LowConf[0]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[0] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); for i := 1 to N-1 do begin ypos := round(vhi * ((Ymax - LowConf[i]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[i] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.LineTo(xpos,ypos); end; end; end; procedure TWLSFrm.Reset; var i: integer; begin inherited; VarList.Clear; for i := 0 to NoVariables - 1 do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i+1,0]); IndVarList.Clear; DepVarEdit.Text := ''; WghtVarEdit.Text := ''; DepInBtn.Enabled := true; DepOutBtn.Enabled := false; IndInBtn.Enabled := true; IndOutBtn.Enabled := false; WghtInBtn.Enabled := true; WghtOutBtn.Enabled := false; OLSChk.Checked := true; PlotChk.Checked := true; RegResChk.Checked := true; WeightChk.Checked := true; UserWghtsChk.Checked := false; OriginChk.Checked := true; Origin2Chk.Checked := true; end; procedure TWLSFrm.UpdateBtnStates; var i: Integer; lSelected: Boolean; begin inherited; lSelected := false; for i:=0 to VarList.Items.Count-1 do if Varlist.Selected[i] then begin lSelected := true; break; end; DepInBtn.Enabled := lSelected and (DepVarEdit.Text = ''); IndInBtn.Enabled := lSelected; WghtInBtn.Enabled := lSelected and (WghtVarEdit.Text = ''); lSelected := false; for i:=0 to IndVarList.Items.Count-1 do if IndVarList.Selected[i] then begin lSelected := true; break; end; DepOutBtn.Enabled := (DepVarEdit.Text <> ''); IndOutBtn.Enabled := lSelected; WghtOutBtn.Enabled := (WghtVarEdit.Text <> ''); end; function TWLSFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; begin Result := false; if DepVarEdit.Text = '' then begin AControl := DepVarEdit; AMsg := 'No dependent variable selected.'; exit; end; if IndVarList.Items.Count = 0 then begin AControl := VarList; AMsg := 'No independent variables selected.'; exit; end; Result := true; end; procedure TWLSFrm.VarListDblClick(Sender: TObject); var index: Integer; begin index := VarList.ItemIndex; if index > -1 then begin if DepVarEdit.Text = '' then DepVarEdit.Text := VarList.Items[index] else IndVarList.Items.Add(VarList.Items[index]); VarList.Items.Delete(index); UpdateBtnStates; end; end; procedure TWLSFrm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; procedure TWLSFrm.WghtInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (WghtVarEdit.Text = '') then begin WghtVarEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TWLSFrm.WghtOutBtnClick(Sender: TObject); begin if (WghtVarEdit.Text <> '') then begin VarList.Items.Add(WghtVarEdit.Text); WghtVarEdit.Text := ''; end; UpdateBtnStates; end; end.