pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Refactor CorrespondenceForm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7374 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-12 14:52:53 +00:00
parent 2aeea55e00
commit 55b63a817f
3 changed files with 852 additions and 834 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

65
applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.lfm
View File

@ -154,93 +154,74 @@ object CorrespondenceForm: TCorrespondenceForm
end
end
object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 261
Left = 353
Height = 25
Top = 503
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 3
end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 327
Height = 25
Top = 503
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 4
end
object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 401
Left = 415
Height = 25
Top = 503
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 5
TabOrder = 4
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 489
Left = 499
Height = 25
Top = 503
Width = 61
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Return'
ModalResult = 1
TabOrder = 6
Caption = 'Close'
ModalResult = 11
TabOrder = 5
end
object HelpBtn: TButton
Tag = 160
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 198
Left = 294
Height = 25
Top = 503
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
@ -267,7 +248,7 @@ object CorrespondenceForm: TCorrespondenceForm
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 487
@ -319,6 +300,7 @@ object CorrespondenceForm: TCorrespondenceForm
BorderSpacing.Right = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = ColListSelectionChange
TabOrder = 0
end
object RowIn: TBitBtn
@ -423,6 +405,7 @@ object CorrespondenceForm: TCorrespondenceForm
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 3
Text = 'RowEdit'
end
@ -442,6 +425,8 @@ object CorrespondenceForm: TCorrespondenceForm
BorderSpacing.Left = 8
BorderSpacing.Right = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = ColListSelectionChange
TabOrder = 6
end
end

573
applications/lazstats/source/forms/analysis/multivariate/correspondenceunit.pas
View File

@ -19,9 +19,8 @@ type
Memo1: TLabel;
Panel1: TPanel;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
ObsChk: TCheckBox;
CheckPChk: TCheckBox;
RowCorres: TCheckBox;
@ -48,21 +47,21 @@ type
ColOut: TBitBtn;
VarList: TListBox;
procedure ColInClick(Sender: TObject);
procedure ColListSelectionChange(Sender: TObject; User: boolean);
procedure ColOutClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax,
Ymin : double; N : integer;
PtLabels : StrDyneVec; titlestr,
Xlabel, Ylabel : string);
procedure PlotXY(Xpoints, Ypoints: DblDyneVec; Xmax, Xmin, Ymax, Ymin: double;
N: integer; PtLabels: StrDyneVec; ATitleStr, Xlabel, Ylabel: string);
procedure RowInClick(Sender: TObject);
procedure RowOutClick(Sender: TObject);
private
{ private declarations }
FAutoSized: Boolean;
procedure UpdateBtnStates;
public
{ public declarations }
end;
@ -73,7 +72,7 @@ var
implementation
uses
Math;
Math, Utils;
{ TCorrespondenceForm }
@ -92,39 +91,49 @@ begin
end;
procedure TCorrespondenceForm.ColInClick(Sender: TObject);
VAR i, index : integer;
var
i: integer;
begin
index := VarList.Items.Count;
i := 0;
while (i < index) do
while (i < VarList.Items.Count) do
begin
if (VarList.Selected[i]) then
if VarList.Selected[i] then
begin
ColList.Items.Add(VarList.Items.Strings[i]);
ColList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
end else
inc(i);
end;
ColOut.Enabled := true;
UpdateBtnStates;
end;
procedure TCorrespondenceForm.ColListSelectionChange(Sender: TObject;
User: boolean);
begin
UpdateBtnStates;
end;
procedure TCorrespondenceForm.ColOutClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := ColList.ItemIndex;
if (index < 0) then
i := 0;
while (i < ColList.Items.Count) do
begin
ColOut.Enabled := false;
exit;
if ColList.Selected[i] then
begin
VarList.Items.Add(ColList.Items[i]);
ColList.Items.Delete(i);
i := 0;
end else
inc(i);
end;
VarList.Items.Add(ColList.Items.Strings[index]);
ColList.Items.Delete(index);
UpdateBtnStates;
end;
procedure TCorrespondenceForm.ComputeBtnClick(Sender: TObject);
VAR
var
i, j, RowNo: integer;
Row, Col, Ncases, Nrows, Ncols, df : integer;
RowLabels, ColLabels : StrDyneVec;
@ -133,7 +142,7 @@ VAR
prompt, xtitle, ytitle : string;
Freq : IntDyneMat;
Prop, Expected, CellChi : DblDyneMat;
ChiSquare, ProbChi, liklihood, probliklihood : double;
ChiSquare, ProbChi, likelihood, problikelihood : double;
SumX, SumY, VarX, VarY, MantelHaenszel, MHprob : double;
yates : boolean;
Adjchisqr, Adjprobchi, phi, pearsonr : double;
@ -161,10 +170,15 @@ VAR
Xmax, Xmin, Ymax, Ymin, Inertia : double;
labels : StrDyneVec;
errorcode : boolean = false;
lReport: TStrings;
begin
if ColList.Items.Count = 0 then
begin
MessageDlg('No column variable(s) selected.', mtError, [mbOK], 0);
exit;
end;
SetLength(ColNoSelected,NoVariables+1);
yates := false;
RowNo := 0;
for i := 1 to NoVariables do
begin
@ -178,10 +192,7 @@ begin
if (RowNo = 0) then
begin
ShowMessage('ERROR! A variable for the row labels was not entered.');
ColNoSelected := nil;
RowLabels := nil;
ColLabels := nil;
MessageDlg('A variable for the row labels was not entered.', mtError, [mbOK], 0);
exit;
end;
ColNoSelected[0] := RowNo;
@ -199,9 +210,7 @@ begin
// Get row labels
for i := 1 to NoCases do
begin
RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[RowNo,i];
end;
// allocate and initialize
SetLength(Freq,Nrows+1,Ncols+1);
@ -228,28 +237,22 @@ begin
Freq[Nrows,Ncols] := Ncases;
// Now, calculate expected values
// Get row totals first
for i := 1 to Nrows do
begin
for j := 1 to Ncols do
begin
Freq[i-1,Ncols] := Freq[i-1,Ncols] + Freq[i-1,j-1];
end;
end;
// Get col totals next
for j := 1 to Ncols do
begin
for i := 1 to Nrows do
begin
Freq[Nrows,j-1] := Freq[Nrows,j-1] + Freq[i-1,j-1];
end;
end;
// Then get expected values and cell chi-squares
ChiSquare := 0.0;
Adjchisqr := 0.0;
if ((YatesChk.Checked) and (Nrows = 2) and (Ncols = 2)) then yates := true;
if ((Nrows > 1) and (Ncols > 1)) then
yates := YatesChk.Checked and (Nrows = 2) and (Ncols = 2);
if (Nrows > 1) and (Ncols > 1) then
begin
for i := 1 to Nrows do
begin
@ -260,14 +263,14 @@ begin
CellChi[i-1,j-1] := sqr(Freq[i-1,j-1] - Expected[i-1,j-1]) / Expected[i-1,j-1]
else
begin
ShowMessage('ERROR! Zero expected value found.');
MessageDlg('Zero expected value found.', mtError, [mbOK], 0);
CellChi[i-1,j-1] := 0.0;
end;
ChiSquare := ChiSquare + CellChi[i-1,j-1];
end;
end;
df := (Nrows - 1) * (Ncols - 1);
if (yates = true) then // 2 x 2 corrected chi-square
if yates then // 2 x 2 corrected chi-square
begin
Adjchisqr := abs((Freq[0,0] * Freq[1,1]) - (Freq[0,1] * Freq[1,0]));
Adjchisqr := sqr(Adjchisqr - Ncases / 2.0) * Ncases; // numerator
@ -275,6 +278,7 @@ begin
Adjprobchi := 1.0 - chisquaredprob(Adjchisqr,df);
end;
end;
if (Nrows = 1) then // equal probability
begin
for j := 0 to Ncols - 1 do
@ -302,45 +306,45 @@ begin
ProbChi := 1.0 - chisquaredprob(ChiSquare, df); // prob. larger chi
// Print acknowledgements
OutputFrm.RichEdit.Lines.Add('CORRESPONDENCE ANALYSIS');
OutputFrm.RichEdit.Lines.Add('Based on formulations of Bee-Leng Lee');
OutputFrm.RichEdit.Lines.Add('Chapter 11 Correspondence Analysis for ViSta');
OutputFrm.RichEdit.Lines.Add('Results are based on the Generalized Singular Value Decomposition');
OutputFrm.RichEdit.Lines.Add('of P := A x D x B where P is the relative frequencies observed,');
OutputFrm.RichEdit.Lines.Add('A are the left generalized singular vectors,');
OutputFrm.RichEdit.Lines.Add('D is a diagonal matrix of generalized singular values, and');
OutputFrm.RichEdit.Lines.Add('B is the transpose of the right generalized singular vectors.');
OutputFrm.RichEdit.Lines.Add('NOTE: The first value and corresponding vectors are 1 and are');
OutputFrm.RichEdit.Lines.Add('to be ignored.');
OutputFrm.RichEdit.Lines.Add('An intermediate step is the regular SVD of the matrix Q := UDV');
OutputFrm.RichEdit.Lines.Add('where Q := Dr^-1/2 x P x Dc^-1/2 where Dr is a diagonal matrix');
OutputFrm.RichEdit.Lines.Add('of total row relative frequencies and Dc is a diagonal matrix');
OutputFrm.RichEdit.Lines.Add('of total column relative frequencies.');
OutputFrm.ShowModal;
lReport := TStringList.Create;
try
lReport.Add('CORRESPONDENCE ANALYSIS');
lReport.Add('Based on formulations of Bee-Leng Lee');
lReport.Add('Chapter 11 Correspondence Analysis for ViSta');
lReport.Add('Results are based on the Generalized Singular Value Decomposition');
lReport.Add('of P := A x D x B where P is the relative frequencies observed,');
lReport.Add('A are the left generalized singular vectors,');
lReport.Add('D is a diagonal matrix of generalized singular values, and');
lReport.Add('B is the transpose of the right generalized singular vectors.');
lReport.Add('NOTE: The first value and corresponding vectors are 1 and are');
lReport.Add('to be ignored.');
lReport.Add('An intermediate step is the regular SVD of the matrix Q := UDV');
lReport.Add('where Q := Dr^-1/2 x P x Dc^-1/2 where Dr is a diagonal matrix');
lReport.Add('of total row relative frequencies and Dc is a diagonal matrix');
lReport.Add('of total column relative frequencies.');
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
//Print results to output form
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('Chi-square Analysis Results');
outline := format('No. of Cases := %d',[Ncases]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('Chi-square Analysis Results');
lReport.Add('No. of Cases: %d', [Ncases]);
lReport.Add('');
// print tables requested by use
if (ObsChk.Checked) then
// print tables requested by user
if ObsChk.Checked then
begin
IntArrayPrint(Freq, Nrows+1, Ncols+1,'Frequencies',
RowLabels, ColLabels,'OBSERVED FREQUENCIES');
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
IntArrayPrint(Freq, Nrows+1, Ncols+1, 'Frequencies', RowLabels, ColLabels, 'OBSERVED FREQUENCIES', lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if (ExpChk.Checked)then
if ExpChk.Checked then
begin
outline := 'EXPECTED FREQUENCIES';
MAT_PRINT(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(Expected, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
outline := 'ROW PROPORTIONS';
@ -350,16 +354,19 @@ begin
begin
if (Freq[i-1,Ncols] > 0.0) then
Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[i-1,Ncols]
else Prop[i-1,j-1] := 0.0;
else
Prop[i-1,j-1] := 0.0;
end;
if (Freq[i-1,Ncols] > 0.0) then Prop[i-1,Ncols] := 1.0
else Prop[i-1,Ncols] := 0.0;
if (Freq[i-1,Ncols] > 0.0) then
Prop[i-1,Ncols] := 1.0
else
Prop[i-1,Ncols] := 0.0;
end;
if (PropsChk.Checked) then
if PropsChk.Checked then
begin
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
outline := 'COLUMN PROPORTIONS';
@ -369,62 +376,64 @@ begin
begin
if (Freq[Nrows,j-1] > 0.0) then
Prop[i-1,j-1] := Freq[i-1,j-1] / Freq[Nrows,j-1]
else Prop[i-1,j-1] := 0.0;
else
Prop[i-1,j-1] := 0.0;
end;
if (Freq[Nrows,j-1] > 0.0) then Prop[Nrows,j-1] := 1.0
else Prop[Nrows,j-1] := 0.0;
if (Freq[Nrows,j-1] > 0.0) then
Prop[Nrows,j-1] := 1.0
else
Prop[Nrows,j-1] := 0.0;
end;
if (PropsChk.Checked) then
if PropsChk.Checked then
begin
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
outline := 'PROPORTIONS OF TOTAL N';
for i := 1 to Nrows + 1 do
for j := 1 to Ncols + 1 do Prop[i-1,j-1] := Freq[i-1,j-1] / Ncases;
Prop[Nrows,Ncols] := 1.0;
MAT_PRINT(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(Prop, Nrows+1, Ncols+1, outline, RowLabels, ColLabels,NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
if (ChiChk.Checked) then
if ChiChk.Checked then
begin
outline := 'CHI-SQUARED VALUE FOR CELLS';
MAT_PRINT(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(CellChi, Nrows, Ncols, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
OutputFrm.RichEdit.Lines.Add('');
outline := format('Chi-square := %8.3f with D.F. := %d. Prob. > value := %8.3f',[ChiSquare,df,ProbChi]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add ('Chi-square: %8.3f', [ChiSquare]);
lReport.Add (' with D.F.: %8d', [df]);
lReport.Add (' and probability > value: %8.3f',[ProbChi]);
lReport.Add('');
if (yates = true) then
if yates then
begin
outline := format('Chi-square using Yates correction = %8.3f and Prob > value := %8.3f',
[Adjchisqr,Adjprobchi]);
OutputFrm.RichEdit.Lines.Add(outline);
lReport.Add('Chi-square using Yates correction: %8.3f', [AdjChiSqr]);
lReport.Add(' with probability > value: %8.3f', [AdjProbChi]);
end;
liklihood := 0.0;
likelihood := 0.0;
for i := 0 to Nrows - 1 do
for j := 0 to Ncols - 1 do
if (Freq[i,j] > 0.0) then liklihood := liklihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j]));
liklihood := -2.0 * liklihood;
probliklihood := 1.0 - chisquaredprob(liklihood,df);
outline := format('Liklihood Ratio := %8.3f with prob. > value := %6.4f',[liklihood,probliklihood]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
if (Freq[i,j] > 0.0) then
likelihood := likelihood + Freq[i,j] * (ln(Expected[i,j] / Freq[i,j]));
likelihood := -2.0 * likelihood;
problikelihood := 1.0 - chisquaredprob(likelihood,df);
lReport.Add ('Likelihood Ratio: %8.3f', [likelihood]);
lReport.Add (' with probability > value: %8.3f', [problikelihood]);
lReport.Add('');
if ((Nrows > 1) and (Ncols > 1)) then
begin
phi := sqrt(ChiSquare / Ncases);
outline := format('phi correlation := %6.4f',[phi]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('phi correlation: %8.4f', [phi]);
lReport.Add('');
pearsonr := 0.0;
SumX := 0.0;
@ -442,34 +451,37 @@ begin
pearsonr := pearsonr + ((i+1)*(j+1) * Freq[i,j]);
pearsonr := pearsonr - (SumX * SumY / Ncases);
pearsonr := pearsonr / sqrt(VarX * VarY);
outline := format('Pearson Correlation r := %6.4f',[pearsonr]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('Pearson Correlation r: %8.4f', [pearsonr]);
lReport.Add('');
MantelHaenszel := (Ncases-1) * (pearsonr * pearsonr);
MHprob := 1.0 - chisquaredprob(MantelHaenszel,1);
outline := format('Mantel-Haenszel Test of Linear Association := %8.3f with probability > value := %6.4f',
[MantelHaenszel, MHprob]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('Mantel-Haenszel Test of Linear Association: %8.3f', [MantelHaenszel]);
lReport.Add(' with probability > value: %8.3f', [MHprob]);
lReport.Add('');
CoefCont := sqrt(ChiSquare / (ChiSquare + Ncases));
outline := format('The coefficient of contingency := %8.3f',[CoefCont]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('The coefficient of contingency: %8.3f', [CoefCont]);
lReport.Add('');
if (Nrows < Ncols) then CramerV := sqrt(ChiSquare / (Ncases * (Nrows-1)))
else CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1))));
outline := format('Cramers V := %8.3f',[CramerV]);
OutputFrm.RichEdit.Lines.Add(outline);
if (Nrows < Ncols) then
CramerV := sqrt(ChiSquare / (Ncases * (Nrows-1)))
else
CramerV := sqrt(ChiSquare / (Ncases * ((Ncols-1))));
lReport.Add('Cramers V: %8.3f', [CramerV]);
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
end;
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
n := Nrows;
q1 := Ncols;
if (n > q1) then largest := n
else largest := q1;
if (n > q1) then
largest := n
else
largest := q1;
SetLength(P,n,q1);
SetLength(r,largest+1);
SetLength(c,q1);
@ -497,28 +509,33 @@ begin
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := 1.0 / sqrt(r[i]);
if (i <> j) then
Dr[i,j] := 0.0
else
Dr[i,j] := 1.0 / sqrt(r[i]);
end;
end;
for i := 0 to q1 - 1 do
begin
for j := 0 to q1 -1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := 1.0 / sqrt(c[j]);
if (i <> j) then
Dc[i,j] := 0.0
else
Dc[i,j] := 1.0 / sqrt(c[j]);
end;
end;
// get q1 := Dr^-1/2 times P times Dc^-1/2
MATAxB(W,Dr,P,n,n,n,q1,errorcode);
MATAxB(q,W,Dc,n,q1,q1,q1,errorcode);
if (ShowqChk.Checked) then
MatAxB(W,Dr,P,n,n,n,q1,errorcode);
MatAxB(q,W,Dc,n,q1,q1,q1,errorcode);
if ShowqChk.Checked then
begin
outline := 'Q Matrix';
MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(q, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end; // wp: added this "end" - maybe wrong?
(*
Instr := InputBox('Save q1 to Main Grid?','Y','N');
if (Instr = 'Y') then
@ -537,30 +554,31 @@ begin
end;
*)
//Obtain ordinary SVD analysis of q1
matinv(q,U,Du,V,q1);
MatInv(q,U,Du,V,q1);
if (EigenChk.Checked) then
if EigenChk.Checked then
begin
outline := 'U Matrix';
MAT_PRINT(U,n,q1,outline,RowLabels,ColLabels,NoCases);
MatPrint(U, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
outline := 'Singular Values';
MAT_PRINT(Du,q1,q1,outline,ColLabels,ColLabels,NoCases);
MatPrint(Du, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
outline := 'V Matrix';
MAT_PRINT(V,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(V, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if (qCheckChk.Checked) then
if qCheckChk.Checked then
begin
// Check to see if q1 is reproduced by U x D x V'
MATAxB(W,U,Du,n,q1,q1,q1,errorcode);
MatAxB(W, U, Du, n, q1, q1, q1, errorcode);
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do Trans[i,j] := V[j,i];
MATAxB(q,W,Trans,n,q1,q1,q1,errorcode);
MatAxB(q, W, Trans, n, q1, q1, q1, errorcode);
outline := 'Reproduced Q = UDV';
MAT_PRINT(q,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(q, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
// Get A := Dr^1/2 times U
@ -568,17 +586,19 @@ begin
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := sqrt(r[i]);
if (i <> j) then
Dr[i,j] := 0.0
else
Dr[i,j] := sqrt(r[i]);
end;
end;
MATAxB(A,Dr,U,n,n,n,q1,errorcode);
if (ShowABChk.Checked) then
MatAxB(A, Dr, U, n, n, n, q1, errorcode);
if ShowABChk.Checked then
begin
outline := 'A Matrix';
MAT_PRINT(A,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(A, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
// Get B := Dc^1/2 times V
@ -586,39 +606,42 @@ begin
begin
for j := 0 to q1-1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := sqrt(c[j]);
if (i <> j) then
Dc[i,j] := 0.0
else
Dc[i,j] := sqrt(c[j]);
end;
end;
MATAxB(B,Dc,V,q1,q1,q1,q1,errorcode);
if (ShowABChk.Checked) then
MatAxB(B, Dc, V, q1, q1, q1, q1, errorcode);
if ShowABChk.Checked then
begin
outline := 'B Matrix';
MAT_PRINT(B,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(B, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if (CheckPChk.Checked) then
begin // see if P := A x Du x B'
if CheckPChk.Checked then
begin // see if P = A x Du x B'
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do Trans[j,i] := B[i,j];
MATAxB(W,A,Du,n,q1,q1,q1,errorcode);
MATAxB(P,W,Trans,n,q1,q1,q1,errorcode);
for j := 0 to q1 - 1 do
Trans[j,i] := B[i,j];
MatAxB(W, A, Du, n, q1, q1, q1, errorcode);
MatAxB(P, W, Trans, n, q1, q1, q1, errorcode);
outline := 'P = ';
MAT_PRINT(P,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(P, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
// show intertia and scree plot
Inertia := ChiSquare / Freq[Nrows,Ncols];
outline := format('Inertia := %8.4f',[Inertia]);
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
if (PlotChk.Checked) then
lReport.Add('Inertia: %8.4f', [Inertia]);
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
if PlotChk.Checked then
begin
SetLength(X,n);
SetLength(Y,n);
@ -633,19 +656,17 @@ begin
begin
X[i] := i;
Y[i] := sqr(Du[i,i]);
outline := format('%4.3f%',[(Y[i] / Inertia)*100.0]);
labels[i] := outline; // 'Dim.' + IntToStr(i);
labels[i] := format('%.3f%',[(Y[i] / Inertia)*100.0]);;
if (X[i] > Xmax) then Xmax := X[i];
if (X[i] < Xmin) then Xmin := X[i];
if (Y[i] > Ymax) then Ymax := Y[i];
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Goodness of Fit Plot';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,labels, title,'Dimension',' ');
BlankFrm.ShowModal;
labels := nil;
Y := nil;
X := nil;
if (Xmax = Xmin) or (Ymax = Ymin) then
MessageDlg('Cannot create ' + title +': zero axis extent.', mtError, [mbOK], 0)
else
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, q1, labels, title, 'Dimension', ' ');
end;
// if (RowCorres.Checked)then
@ -655,39 +676,45 @@ begin
begin
for j := 0 to n - 1 do
begin
if (i <> j) then Dr[i,j] := 0.0
else Dr[i,j] := 1.0 / r[i];
if (i <> j) then
Dr[i,j] := 0.0
else
Dr[i,j] := 1.0 / r[i];
end;
end;
MATAxB(W,Dr,A,n,n,n,q1,errorcode);
MatAxB(W, Dr, A, n, n, n, q1, errorcode);
// ArrayPrint(W,n,q1,'Dr x A matrix',RowLabels,ColLabels,'Dr x A Matrix');
// FrmOutPut.ShowModal;
MATAxB(F,W,Du,n,q1,q1,q1,errorcode);
if (RowCorres.Checked) then
MatAxB(F, W, Du, n, q1, q1, q1, errorcode);
if RowCorres.Checked then
begin
outline := 'Row Dimensions (Ignore Col. 1';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
outline := 'Row Dimensions (Ignore Col. 1)';
MatPrint(F, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
// Get Column coordinates G (row profile analysis)
for i := 0 to q1 - 1 do
begin
for j := 0 to q1 - 1 do
begin
if (i <> j) then Dc[i,j] := 0.0
else Dc[i,j] := 1.0 / c[j];
if (i <> j) then
Dc[i,j] := 0.0
else
Dc[i,j] := 1.0 / c[j];
end;
end;
MATAxB(Gc,Dc,B,q1,q1,q1,q1,errorcode);
if (RowCorres.Checked) then
MatAxB(Gc, Dc, B, q1, q1, q1, q1, errorcode);
if RowCorres.Checked then
begin
outline := 'Col. Dimensions (Ignore Col. 1';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
outline := 'Col. Dimensions (Ignore Col. 1)';
MatPrint(Gc, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if ((PlotChk.Checked) and (RowCorres.Checked))then
if PlotChk.Checked and RowCorres.Checked then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
@ -711,10 +738,10 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, n, RowLabels, title, xtitle, ytitle);
Y := nil;
X := nil;
SetLength(X,q1);
SetLength(Y,q1);
Xmax := -10000.0;
@ -731,8 +758,7 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, q1, ColLabels, title, xtitle, ytitle);
Y := nil;
X := nil;
end;
@ -743,22 +769,23 @@ begin
// begin
for i := 0 to q1 - 1 do
for j := 0 to q1 - 1 do W[i,j] := Gc[i,j]; // use last Gc
MATAxB(Gc,W,Du,q1,q1,q1,q1,errorcode); // multiply times Du
if (ColCorrChk.Checked) then
MatAxB(Gc,W,Du,q1,q1,q1,q1,errorcode); // multiply times Du
if ColCorrChk.Checked then
begin
outline := 'Column Dimensions (Ignore Col. 1';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
MatPrint(Gc, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
MATAxB(F,Dr,A,n,n,n,q1,errorcode); // Get new F
if (ColCorrChk.Checked) then
MatAxB(F,Dr,A,n,n,n,q1,errorcode); // Get new F
if ColCorrChk.Checked then
begin
outline := 'Row Dimensions (Ignore Col. 1)';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
MatPrint(F, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if ((PlotChk.Checked) and (ColCorrChk.Checked)) then
if PlotChk.Checked and ColCorrChk.Checked then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
@ -782,10 +809,8 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, q1, ColLabels, title, xtitle, ytitle);
SetLength(X, n);
SetLength(Y, n);
Xmax := -10000.0;
@ -802,27 +827,28 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, n, RowLabels, title, xtitle, ytitle);
end;
// end;
// do both if checked
if (BothCorrChk.Checked) then
if BothCorrChk.Checked then
begin
// F is same as for Row correspondence and Gc is same as for columns
for i := 0 to n - 1 do
for j := 0 to q1 - 1 do W[i,j] := F[i,j];
MATAxB(F,W,Du,n,q1,q1,q1,errorcode);
MatAxB(F, W, Du, n, q1, q1, q1, errorcode);
outline := 'Row Dimensions (Ignore Col. 1';
MAT_PRINT(F,n,q1,outline,RowLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
MatPrint(F, n, q1, outline, RowLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
outline := 'Column Dimensions (Ignore Col. 1)';
MAT_PRINT(Gc,q1,q1,outline,ColLabels,ColLabels,NoCases);
OutputFrm.ShowModal;
if (PlotChk.Checked)then
MatPrint(Gc, q1, q1, outline, ColLabels, ColLabels, NoCases, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
if PlotChk.Checked then
begin
prompt := InputBox('X Axis Dimension','1','1');
IX := StrToInt(prompt);
@ -846,10 +872,8 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Row Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,n,RowLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, n, RowLabels, title, xtitle, ytitle);
SetLength(X,q1);
SetLength(Y,q1);
Xmax := -10000.0;
@ -866,15 +890,14 @@ begin
if (Y[i] < Ymin) then Ymin := Y[i];
end;
title := 'Column Dimensions';
plotxy(X,Y,Xmax,Xmin,Ymax,Ymin,q1,ColLabels, title,xtitle,ytitle);
BlankFrm.ShowModal;
Y := nil;
X := nil;
PlotXY(X, Y, Xmax, Xmin, Ymax, Ymin, q1, ColLabels, title, xtitle, ytitle);
end;
end;
// FrmOutPut.ShowModal;
// clean up memory
DisplayReport(lReport);
finally
lReport.Free;
Gc := nil;
F := nil;
Trans := nil;
@ -906,12 +929,12 @@ begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
@ -921,8 +944,6 @@ end;
procedure TCorrespondenceForm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
if BlankFrm = nil then
Application.CreateForm(TBlankFrm, BlankFrm);
end;
@ -932,16 +953,14 @@ begin
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TCorrespondenceForm.plotxy(Xpoints, Ypoints : DblDyneVec; Xmax, Xmin, Ymax,
Ymin : double; N : integer;
PtLabels : StrDyneVec; titlestr,
Xlabel, Ylabel : string);
VAR
procedure TCorrespondenceForm.PlotXY(Xpoints, Ypoints: DblDyneVec;
Xmax, Xmin, Ymax, Ymin: double; N: integer; PtLabels: StrDyneVec;
ATitlestr, 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, astring, outline : string;
begin
Title := 'X versus Y PLOT';
BlankFrm.Caption := Title;
@ -974,7 +993,7 @@ begin
BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
ypos := ypos + 10;
BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
outline := format('%6.2f',[Xvalue]);
outline := format('%.2f',[Xvalue]);
Title := outline;
offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
xpos := xpos - offset;
@ -1000,8 +1019,7 @@ begin
for i := 1 to 11 do
begin
value := Ymax - ((i-1) * valincr);
outline := format('%8.3f',[value]);
Title := outline;
Title := format('%.3f', [value]);
strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
xpos := 10;
Yvalue := Ymax - (valincr * (i-1));
@ -1031,28 +1049,43 @@ begin
BlankFrm.Image1.Canvas.Brush.Color := clWhite;
BlankFrm.Image1.Canvas.TextOut(xpos+3,ypos-5,PtLabels[i]);
end;
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(titlestr) div 2);
xpos := hleft + (hwide div 2) - (BlankFrm.Image1.Canvas.TextWidth(ATitleStr) div 2);
ypos := vbottom + 40;
BlankFrm.Image1.Canvas.TextOut(xpos,ypos,titlestr);
BlankFrm.Image1.Canvas.TextOut(xpos, ypos, ATitleStr);
BlankFrm.ShowModal;
end;
procedure TCorrespondenceForm.RowInClick(Sender: TObject);
VAR
var
index: integer;
begin
index := VarList.ItemIndex;
RowEdit.Text := VarList.Items.Strings[index];
if (index > -1) and (RowEdit.Text = '') then
begin
RowEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
RowIn.Enabled := false;
RowOut.Enabled := true;
end;
UpdateBtnStates;
end;
procedure TCorrespondenceForm.RowOutClick(Sender: TObject);
begin
if RowEdit.Text <> '' then
begin
VarList.Items.Add(RowEdit.Text);
RowEdit.Text := '';
RowIn.Enabled := true;
RowOut.Enabled := false;
end;
UpdateBtnStates;
end;
procedure TCorrespondenceForm.UpdateBtnStates;
begin
RowIn.Enabled := (VarList.ItemIndex > -1) and (RowEdit.Text = '');
RowOut.Enabled := (RowEdit.Text <> '');
ColIn.Enabled := AnySelected(VarList);
ColOut.Enabled := AnySelected(ColList);
end;
initialization