unit WLSUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, Globals, MainUnit, DictionaryUnit, functionslib, matrixlib, PlotXYUnit, outputunit, DataProcs, blankfrmunit, contexthelpunit; type { TWLSFrm } TWLSFrm = class(TForm) DepInBtn: TBitBtn; DepOutBtn: TBitBtn; HelpBtn: TButton; IndInBtn: TBitBtn; IndOutBtn: TBitBtn; WghtInBtn: TBitBtn; WghtOutBtn: TBitBtn; ResetBtn: TButton; CancelBtn: TButton; ComputeBtn: TButton; ReturnBtn: TButton; OLSChk: TCheckBox; PlotChk: TCheckBox; RegResChk: TCheckBox; SaveChk: TCheckBox; WeightChk: TCheckBox; OriginChk: TCheckBox; UserWghtsChk: TCheckBox; Origin2Chk: TCheckBox; DepVarEdit: TEdit; WghtVarEdit: TEdit; GroupBox1: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; IndVarList: TListBox; VarList: TListBox; procedure ComputeBtnClick(Sender: TObject); procedure DepInBtnClick(Sender: TObject); procedure DepOutBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure HelpBtnClick(Sender: TObject); procedure IndInBtnClick(Sender: TObject); procedure IndOutBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject); procedure WghtInBtnClick(Sender: TObject); procedure WghtOutBtnClick(Sender: TObject); procedure PredictIt(ColNoSelected : IntDyneVec; NoVars : integer; Means, StdDevs, BetaWeights : DblDyneVec; StdErrEst : double; NoIndepVars : integer); procedure plotxy(Xpoints, Ypoints, UpConf, LowConf : DblDyneVec; ConfBand, Xmean, Ymean, R, Slope, Intercept : double; Xmax, Xmin, Ymax, Ymin : double; N : integer; XLabel, YLabel : string); private { private declarations } public { public declarations } end; var WLSFrm: TWLSFrm; implementation { TWLSFrm } procedure TWLSFrm.ResetBtnClick(Sender: TObject); VAR i : integer; begin 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.Visible := true; DepOutBtn.Visible := false; IndInBtn.Visible := true; IndOutBtn.Visible := false; WghtInBtn.Visible := true; WghtOutBtn.Visible := 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.WghtInBtnClick(Sender: TObject); VAR index : integer; begin if (VarList.Items.Count < 1) then exit; index := VarList.ItemIndex; WghtVarEdit.Text := VarList.Items.Strings[index]; VarList.Items.Delete(index); WghtOutBtn.Visible := true; WghtInBtn.Visible := false; end; procedure TWLSFrm.WghtOutBtnClick(Sender: TObject); begin if (WghtVarEdit.Text = '') then exit; VarList.Items.Add(WghtVarEdit.Text); WghtVarEdit.Text := ''; WghtInBtn.Visible := true; WghtOutBtn.Visible := false; end; procedure TWLSFrm.FormShow(Sender: TObject); begin ResetBtnClick(self); end; procedure TWLSFrm.HelpBtnClick(Sender: TObject); begin ContextHelpForm.HelpMessage((Sender as TButton).tag); end; procedure TWLSFrm.IndInBtnClick(Sender: TObject); VAR i, index : integer; begin if (VarList.Items.Count < 1) then exit; index := VarList.SelCount; i := 0; while (i < VarList.Items.Count) do begin if (VarList.Selected[i]) then begin IndVarList.Items.Add(VarList.Items.Strings[i]); VarList.Items.Delete(i); // index--; i := 0; end else i := i + 1; end; IndOutBtn.Visible := true; if (VarList.Items.Count < 1) then IndInBtn.Visible := false; end; procedure TWLSFrm.IndOutBtnClick(Sender: TObject); VAR index : integer; begin index := IndVarList.ItemIndex; VarList.Items.Add(IndVarList.Items.Strings[index]); IndVarList.Items.Delete(index); IndInBtn.Visible := true; if (IndVarList.Items.Count < 1) then IndOutBtn.Visible := false; end; procedure TWLSFrm.DepInBtnClick(Sender: TObject); VAR index : integer; begin if (VarList.Items.Count < 1) then exit; index := VarList.ItemIndex; DepVarEdit.Text := VarList.Items.Strings[index]; VarList.Items.Delete(index); DepOutBtn.Visible := true; DepInBtn.Visible := false; end; procedure TWLSFrm.ComputeBtnClick(Sender: TObject); VAR i, ii, j, Noindep, DepCol, WghtCol, olddepcol, NCases, pos, col : integer; IndepCols : IntDyneVec; RowLabels : StrDyneVec; R2, F, stderrest, X, Y : double; Means, Variances, StdDevs, BWeights : DblDyneVec; BetaWeights, BStdErrs, Bttests, tprobs : DblDyneVec; errorcode, PrintDesc, PrintCorrs, PrintInverse, PrintCoefs, SaveCorrs : boolean; aresult : boolean; outval : string; Xpoints, Ypoints, UpConf, lowConf : DblDyneVec; 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; outline : string; XLabel, YLabel : string; N, Xcol, Ycol, NoSelected : integer; label cleanup; begin PrintDesc := true; PrintCorrs := true; PrintInverse := false; PrintCoefs := true; SaveCorrs := false; 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); NCases := NoCases; Noindep := IndVarList.Items.Count; if (Noindep = 0) then begin ShowMessage('ERROR! No independent variables selected.'); goto cleanup; end; DepCol := 0; 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 ShowMessage('ERROR! No independent variable selected.'); goto cleanup; end; // check variable types aresult := ValidValue(DepCol,0); if (aresult = false) then goto cleanup; if (WghtCol > 0) then begin aresult := ValidValue(WghtCol,0); if (aresult = false) then goto cleanup; end; for j := 0 to Noindep - 1 do begin aresult := ValidValue(IndepCols[j],0); if (aresult = false) then goto cleanup; end; IndepCols[Noindep] := DepCol; olddepcol := DepCol; // save dependent column so we can reuse DepCol if (OLSChk.Checked) then // Get OLS regression begin OutPutFrm.RichEdit.Lines.Add('OLS REGRESSION RESULTS'); mreg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc); // 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); OutPutFrm.ShowModal; OutPutFrm.RichEdit.Clear; end; if (( RegResChk.Checked) and (OLSChk.Checked) ) then begin // Regress the squared residuals on the predictors DepCol := NoVariables; OutPutFrm.RichEdit.Lines.Add('REGRESSION OF SQUARED RESIDUALS ON INDEPENDENT VARIABLES'); mreg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc); OutPutFrm.ShowModal; OutPutFrm.RichEdit.Clear; end; if ((WeightChk.Checked) and (RegResChk.Checked) ) then begin // Get predicted squared residuals and save recipricols as weights col := NoVariables + 1; // NoVariables := col; OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables); DictionaryFrm.NewVar(col); DictionaryFrm.DictGrid.Cells[1,col] := 'PredResid2'; OS3MainFrm.DataGrid.Cells[col,0] := 'PredResid2'; col := NoVariables + 1; // NoVariables := col; 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 (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); outval := format('%8.3f',[predicted]); OS3MainFrm.DataGrid.Cells[col-1,i] := outval; if (predicted > 0.0) then begin predicted := sqrt(predicted); predicted := 1.0 / predicted; end else predicted := 0.0; outval := format('%8.3f',[predicted]); OS3MainFrm.DataGrid.Cells[col,i] := outval; end; // if valid case end; // next i end; // if regresChk // Now, plot squared residuals against each independent variable if ((PlotChk.Checked) and (RegResChk.Checked)) then begin Xcol := DepCol; for ii := 0 to Noindep - 1 do begin 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.0e20; Xmin := 1.0e20; Ymax := -1.0e20; Ymin := 1.0e20; Xmean := 0.0; Ymean := 0.0; Xvariance := 0.0; Yvariance := 0.0; R := 0.0; for i := 1 to NoCases do begin if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue; N := N + 1; 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); end; // sort on X for i := 1 to N - 1 do begin for j := i + 1 to N do begin if (Xpoints[i] > Xpoints[j]) then //swap begin temp := Xpoints[i]; Xpoints[i] := Xpoints[j]; Xpoints[j] := temp; temp := Ypoints[i]; Ypoints[i] := Ypoints[j]; Ypoints[j] := temp; end; end; end; // 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 OutPutFrm.RichEdit.Lines.Add('X versus Y Plot'); OutPutFrm.RichEdit.Lines.Add(''); outline := format('X := %s, Y := %s from file: %s',[OS3MainFrm.DataGrid.Cells[Xcol,0], OS3MainFrm.DataGrid.Cells[Ycol,0],OS3MainFrm.FileNameEdit.Text]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.RichEdit.Lines.Add(''); OutPutFrm.RichEdit.Lines.Add('Variable Mean Variance Std.Dev.'); outline := format('%-10s%8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[Xcol,0],Xmean,Xvariance,Xstddev]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('%-10s%8.2f %8.2f %8.2f', [OS3MainFrm.DataGrid.Cells[Ycol,0],Ymean,Yvariance,Ystddev]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Correlation := %6.4f, Slope := %8.2f, Intercept := %8.2f', [R, Slope, Intercept]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Standard Error of Estimate := %8.2f',[SEPred]); OutPutFrm.RichEdit.Lines.Add(outline); outline := format('Number of good cases := %d',[N]); OutPutFrm.RichEdit.Lines.Add(outline); OutPutFrm.ShowModal; OutPutFrm.RichEdit.Clear; // get upper and lower confidence points for each X value ConfBand := 0.95; DF := N - 2; t := inverset(ConfBand,DF); for i := 1 to N 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 (and optional line and confidence band if elected) plotxy(Xpoints, Ypoints, UpConf, lowConf, ConfBand, Xmean, Ymean, R, Slope, Intercept, Xmax, Xmin, Ymax, Ymin, N, XLabel, YLabel); BlankFrm.ShowModal; // cleanup // ColNoSelected := nil; // lowConf := nil; // UpConf := nil; // Ypoints := nil; // Xpoints := nil; end; end; 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[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; 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 (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 (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 OutPutFrm.RichEdit.Lines.Add('WLS REGRESSION RESULTS'); mreg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc); OutPutFrm.ShowModal; end // if useweightschk checked else if (UserWghtsChk.Checked) then // use the weights entered by the user 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 (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 (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 OutPutFrm.RichEdit.Lines.Add('WLS REGRESSION RESULTS'); mreg(Noindep, IndepCols, DepCol, RowLabels, Means, Variances, StdDevs, BWeights, BetaWeights, BStdErrs, Bttests, tprobs, R2, stderrest, NCases, errorcode, PrintDesc); OutPutFrm.ShowModal; end; cleanup: IndepCols := nil; RowLabels := nil; tprobs := nil; Bttests := nil; BStdErrs := nil; BetaWeights := nil; BWeights := nil; StdDevs := nil; Variances := nil; Means := nil; ColNoSelected := nil; lowConf := nil; UpConf := nil; Ypoints := nil; Xpoints := nil; // reset the variables for possible second step of WLS ResetBtnClick(self); end; procedure TWLSFrm.DepOutBtnClick(Sender: TObject); begin if (DepVarEdit.Text = '') then exit; VarList.Items.Add(DepVarEdit.Text); DepVarEdit.Text := ''; DepInBtn.Visible := true; DepOutBtn.Visible := false; end; procedure TWLSFrm.PredictIt(ColNoSelected : IntDyneVec; NoVars : integer; Means, StdDevs, BetaWeights : DblDyneVec; StdErrEst : double; NoIndepVars : integer); VAR col, i, j, k, Index, IndexX, IndexY : integer; predicted, zpredicted, z1, z2, resid, Term1, Term2, residsqr : double; StdErrPredict, t95, Hi95, Low95 : double; astring : string; begin // 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 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; astring := format('%8.4f',[zpredicted]); OS3MainFrm.DataGrid.Cells[col-1,i] := astring; Index := ColNoSelected[NoVars-1]; z2 := StrToFloat(OS3MainFrm.DataGrid.Cells[Index,i]); z2 := (z2 - Means[NoVars-1]) / StdDevs[NoVars-1]; // z score astring := format('%8.4f',[z2 - zpredicted]); // z residual OS3MainFrm.DataGrid.Cells[col,i] := astring; end; // Get raw predicted and residuals col := NoVariables + 1; // NoVariables := col; 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]; astring := format('%8.3f',[predicted]); OS3MainFrm.DataGrid.Cells[col,i] := astring; end; // Calculate residuals of predicted raw scores end; col := NoVariables +1; // NoVariables := col; 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]); astring := format('%8.3f',[resid]); OS3MainFrm.DataGrid.Cells[col,i] := astring; end; // get square of raw residuals col := NoVariables + 1; // NoVariables := col; 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; astring := format('%8.3f',[residsqr]); OS3MainFrm.DataGrid.Cells[col,i] := astring; end; 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; maxval, minval, 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 := 1 to N 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[1]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); for i := 2 to N 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[1]) / (Ymax - Ymin))); ypos := ypos + vtop; xpos := round(hwide * ( (Xpoints[1] - Xmin) / (Xmax - Xmin))); xpos := xpos + hleft; BlankFrm.Image1.Canvas.MoveTo(xpos,ypos); for i := 2 to N 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; initialization {$I wlsunit.lrs} end.