LazStats: Remove Cancel button from CanonUnit, improved usability of arrow buttons, create text report in TStringlist, not in OutputFrm. Add help to help file.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7362 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-07 21:08:21 +00:00
parent 481f65a802
commit ff026810af
4 changed files with 501 additions and 464 deletions

View File

@ -66,84 +66,66 @@ object CannonFrm: TCannonFrm
end end
end end
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 104 Left = 192
Height = 25 Height = 25
Top = 346 Top = 346
Width = 54 Width = 54
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Reset' Caption = 'Reset'
OnClick = ResetBtnClick OnClick = ResetBtnClick
TabOrder = 3 TabOrder = 3
end end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 170
Height = 25
Top = 346
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 4
end
object ComputeBtn: TButton object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 244 Left = 254
Height = 25 Height = 25
Top = 346 Top = 346
Width = 76 Width = 76
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Compute' Caption = 'Compute'
OnClick = ComputeBtnClick OnClick = ComputeBtnClick
TabOrder = 5 TabOrder = 4
end end
object ReturnBtn: TButton object CloseBtn: TButton
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 332 Left = 338
Height = 25 Height = 25
Top = 346 Top = 346
Width = 61 Width = 55
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Return' Caption = 'Close'
ModalResult = 1 ModalResult = 11
TabOrder = 6 TabOrder = 5
end end
object HelpBtn: TButton object HelpBtn: TButton
Tag = 111 Tag = 111
AnchorSideRight.Control = ResetBtn AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 41 Left = 133
Height = 25 Height = 25
Top = 346 Top = 346
Width = 51 Width = 51
@ -151,7 +133,7 @@ object CannonFrm: TCannonFrm
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Help' Caption = 'Help'
OnClick = HelpBtnClick OnClick = HelpBtnClick
@ -161,7 +143,7 @@ object CannonFrm: TCannonFrm
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn AnchorSideBottom.Control = CloseBtn
Left = 0 Left = 0
Height = 8 Height = 8
Top = 330 Top = 330
@ -235,6 +217,7 @@ object CannonFrm: TCannonFrm
Constraints.MinHeight = 220 Constraints.MinHeight = 220
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object LeftIn: TBitBtn object LeftIn: TBitBtn
@ -461,6 +444,8 @@ object CannonFrm: TCannonFrm
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 16 BorderSpacing.Bottom = 16
ItemHeight = 0 ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
object RightList: TListBox object RightList: TListBox
@ -478,6 +463,8 @@ object CannonFrm: TCannonFrm
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
ItemHeight = 0 ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 6 TabOrder = 6
end end
end end

View File

@ -1,3 +1,5 @@
// File for testing: cansas.laz
unit CanonUnit; unit CanonUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -19,9 +21,8 @@ type
HelpBtn: TButton; HelpBtn: TButton;
Panel1: TPanel; Panel1: TPanel;
ResetBtn: TButton; ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
ReturnBtn: TButton; CloseBtn: TButton;
CorsChk: TCheckBox; CorsChk: TCheckBox;
InvChk: TCheckBox; InvChk: TCheckBox;
EigenChk: TCheckBox; EigenChk: TCheckBox;
@ -47,9 +48,11 @@ type
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure RightInClick(Sender: TObject); procedure RightInClick(Sender: TObject);
procedure RightOutClick(Sender: TObject); procedure RightOutClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
procedure UpdateBtnStates;
public public
{ public declarations } { public declarations }
end; end;
@ -60,54 +63,57 @@ var
implementation implementation
uses uses
Math; Math,
Utils;
{ TCannonFrm } { TCannonFrm }
procedure TCannonFrm.ResetBtnClick(Sender: TObject); procedure TCannonFrm.ResetBtnClick(Sender: TObject);
VAR i : integer; var
i: integer;
begin begin
VarList.Clear; VarList.Clear;
LeftList.Clear; LeftList.Clear;
RightList.Clear; RightList.Clear;
LeftOut.Enabled := false;
LeftIn.Enabled := true;
RightOut.Enabled := false;
RightIn.Enabled := true;
for i := 1 to NoVariables do for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end; end;
procedure TCannonFrm.RightInClick(Sender: TObject); procedure TCannonFrm.RightInClick(Sender: TObject);
VAR i, index : integer; var
i: integer;
begin begin
index := VarList.Items.Count;
i := 0; i := 0;
while i < index do while i < VarList.Items.Count do
begin begin
if (VarList.Selected[i]) then if VarList.Selected[i] then
begin begin
RightList.Items.Add(VarList.Items.Strings[i]); RightList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i); VarList.Items.Delete(i);
index := index - 1;
i := 0; i := 0;
end end else
else i := i + 1; i := i + 1;
end; end;
RightOut.Enabled := true; UpdateBtnStates;
end; end;
procedure TCannonFrm.RightOutClick(Sender: TObject); procedure TCannonFrm.RightOutClick(Sender: TObject);
VAR index : integer; var
i: integer;
begin begin
index := RightList.ItemIndex; i := 0;
if index < 0 then while i < RightList.Items.Count do
begin begin
RightOut.Enabled := false; if RightList.Selected[i] then
exit; begin
VarList.Items.Add(RightList.Items[i]);
RightList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end; end;
VarList.Items.Add(RightList.Items.Strings[index]); UpdateBtnStates;
RightList.Items.Delete(index);
end; end;
procedure TCannonFrm.FormActivate(Sender: TObject); procedure TCannonFrm.FormActivate(Sender: TObject);
@ -117,12 +123,11 @@ begin
if FAutoSized then if FAutoSized then
exit; 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; HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width; Constraints.MinWidth := Width;
Constraints.MinHeight := Height; Constraints.MinHeight := Height;
@ -133,7 +138,6 @@ end;
procedure TCannonFrm.FormCreate(Sender: TObject); procedure TCannonFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm);
end; end;
procedure TCannonFrm.FormShow(Sender: TObject); procedure TCannonFrm.FormShow(Sender: TObject);
@ -149,7 +153,8 @@ begin
end; end;
procedure TCannonFrm.ComputeBtnClick(Sender: TObject); procedure TCannonFrm.ComputeBtnClick(Sender: TObject);
label cleanup; const
SEPARATOR = '===========================================================================';
var var
i, j, k, count, a_size, b_size, no_factors, novars, IER: integer; i, j, k, count, a_size, b_size, no_factors, novars, IER: integer;
outline, cellstring, gridstring: string; outline, cellstring, gridstring: string;
@ -165,11 +170,23 @@ var
selected : IntDyneVec; selected : IntDyneVec;
RowLabels, ColLabels : StrDyneVec; RowLabels, ColLabels : StrDyneVec;
CanLabels : StrDyneVec; CanLabels : StrDyneVec;
NCases : integer;
title : string; title : string;
errorcode : boolean = false; NCases: integer = 0;
errorcode: boolean = false;
lReport: TStrings;
begin begin
if LeftList.Items.Count = 0 then
begin
MessageDlg('No left-hand variable selected.', mtError, [mbOK], 0);
exit;
end;
if RightList.Items.Count = 0 then
begin
MessageDlg('No right-hand variable selected.', mtError, [mbOK], 0);
exit;
end;
k := 0; k := 0;
no_factors := 0; no_factors := 0;
pcnt_extracted := 0.0; pcnt_extracted := 0.0;
@ -249,7 +266,9 @@ begin
end; end;
end; end;
end; end;
for i := 0 to b_size - 1 do // identify left variables
// identify left variables
for i := 0 to b_size - 1 do
begin begin
cellstring := RightList.Items.Strings[i]; cellstring := RightList.Items.Strings[i];
for j := 1 to NoVariables do for j := 1 to NoVariables do
@ -264,19 +283,23 @@ begin
end; end;
// build list of all variables selected // build list of all variables selected
for i := 1 to a_size do selected[i-1] := a_vars[i-1]; for i := 1 to a_size do
for i := 1 to b_size do selected[i-1 + a_size] := b_vars[i-1]; selected[i-1] := a_vars[i-1];
for i := 1 to b_size do
selected[i-1 + a_size] := b_vars[i-1];
lReport := TStringList.Create;
try
lReport.Add('CANONICAL CORRELATION ANALYSIS');
lReport.Add('');
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('CANONICAL CORRELATION ANALYSIS');
OutputFrm.RichEdit.Lines.Add('');
// Get means, standard deviations, etc. for total matrix // Get means, standard deviations, etc. for total matrix
Correlations(novars,selected,bigmat,mean,variance,stddev,errorcode,Ncases); Correlations(novars,selected,bigmat,mean,variance,stddev,errorcode,Ncases);
count := Ncases; count := Ncases;
if (IER = 1)then if (IER = 1)then
begin begin
ShowMessage('Zero variance found for a variable-terminating'); MessageDlg('Zero variance found for a variable-terminating', mtError, [mbOK], 0);
goto cleanup; exit;
end; end;
//partition matrix into quadrants //partition matrix into quadrants
@ -298,24 +321,25 @@ begin
if CorsChk.Checked then if CorsChk.Checked then
begin begin
title := 'Left Correlation Matrix'; title := 'Left Correlation Matrix';
MAT_PRINT(raa,a_size,a_size,title,RowLabels,RowLabels,NCases); MatPrint(raa, a_size, a_size, title, RowLabels, RowLabels, NCases, lReport);
title := 'Right Correlation Matrix'; title := 'Right Correlation Matrix';
MAT_PRINT(rbb,b_size,b_size,title,ColLabels,ColLabels,NCases); MatPrint(rbb, b_size, b_size, title, ColLabels, ColLabels, NCases, lReport);
title := 'Left-Right Correlation Matrix'; title := 'Left-Right Correlation Matrix';
MAT_PRINT(rab,a_size,b_size,title,RowLabels,ColLabels,NCases); MatPrint(rab, a_size, b_size, title, RowLabels, ColLabels, NCases, lReport);
OutputFrm.ShowModal; lReport.Add('');
OutputFrm.RichEdit.Clear; lReport.Add(SEPARATOR);
lReport.Add('');
end; end;
// get inverses of left and right hand matrices raa and rbb // get inverses of left and right hand matrices raa and rbb
for i := 1 to a_size do for i := 1 to a_size do
for j := 1 to a_size do for j := 1 to a_size do
raainv[i-1,j-1] := raa[i-1,j-1]; raainv[i-1,j-1] := raa[i-1,j-1];
SVDinverse(raainv,a_size); SVDinverse(raainv, a_size);
if InvChk.Checked then if InvChk.Checked then
begin begin
title := 'Inverse of Left Matrix'; title := 'Inverse of Left Matrix';
MAT_PRINT(raainv,a_size,a_size,title,RowLabels,RowLabels,NCases); MatPrint(raainv, a_size, a_size, title, RowLabels, RowLabels, NCases, lReport);
end; end;
for i := 1 to b_size do for i := 1 to b_size do
@ -325,24 +349,26 @@ begin
if InvChk.Checked then if InvChk.Checked then
begin begin
title := 'Inverse of Right Matrix'; title := 'Inverse of Right Matrix';
MAT_PRINT(rbbinv,b_size,b_size,title,ColLabels,ColLabels,NCases); MatPrint(rbbinv, b_size, b_size, title, ColLabels, ColLabels, NCases, lReport);
end; end;
// get products of raainv x rab and the rbbinv x rba matrix // get products of raainv x rab and the rbbinv x rba matrix
MatAxB(first_prod,rbbinv,rba,b_size,b_size,b_size,a_size,errorcode); MatAxB(first_prod,rbbinv,rba,b_size,b_size,b_size,a_size,errorcode);
MatAxB(second_prod,raainv,rab,a_size,a_size,a_size,b_size,errorcode); MatAxB(second_prod,raainv,rab,a_size,a_size,a_size,b_size,errorcode);
title := 'Right Inverse x Right-Left Matrix'; title := 'Right Inverse x Right-Left Matrix';
MAT_PRINT(first_prod,b_size,a_size,title,ColLabels,RowLabels,NCases); MatPrint(first_prod, b_size, a_size, title, ColLabels, RowLabels, NCases, lReport);
title := 'Left Inverse x Left-Right Matrix'; title := 'Left Inverse x Left-Right Matrix';
MAT_PRINT(second_prod,a_size,b_size,title,RowLabels,ColLabels,NCases); MatPrint(second_prod, a_size, b_size, title, RowLabels, ColLabels, NCases, lReport);
//get characteristic equations matrix (product of last two product matrices //get characteristic equations matrix (product of last two product matrices
//The product should yeild rows and cols representing the smaller of the two sets //The product should yeild rows and cols representing the smaller of the two sets
MatAxB(char_equation,first_prod,second_prod,b_size,a_size, a_size,b_size,errorcode); MatAxB(char_equation,first_prod,second_prod,b_size,a_size, a_size,b_size,errorcode);
title := 'Canonical Function'; title := 'Canonical Function';
MAT_PRINT(char_equation,b_size,b_size,title,CanLabels,CanLabels,NCases); MatPrint(char_equation, b_size, b_size, title, CanLabels, CanLabels, NCases, lReport);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear; lReport.Add('');
lReport.Add(SEPARATOR);
lReport.Add('');
// now get roots and vectors of the characteristic equation using // now get roots and vectors of the characteristic equation using
// NonSymRoots routine // NonSymRoots routine
@ -357,13 +383,11 @@ begin
no_factors := b_size; no_factors := b_size;
nonsymroots(char_equation, b_size, no_factors, minroot, eigenvectors, roots, nonsymroots(char_equation, b_size, no_factors, minroot, eigenvectors, roots,
pcnt_trace, trace, pcnt_extracted); pcnt_trace, trace, pcnt_extracted);
outline := format('Trace of the matrix:=%10.4f',[trace]); lReport.Add('Trace of the matrix: %10.4f', [trace]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('Percent of trace extracted: %10.4f', [pcnt_extracted]);
outline := format('Percent of trace extracted: %10.4f',[pcnt_extracted]);
OutputFrm.RichEdit.Lines.Add(outline);
// Normalize smaller set weights and coumpute larger set weights // Normalize smaller set weights and coumpute larger set weights
MATTRN(eigentrans,eigenvectors,b_size,b_size); MatTrn(eigentrans, eigenvectors, b_size, b_size);
MatAxB(tempmat,eigentrans,rbb,b_size,b_size,b_size,b_size,errorcode); MatAxB(tempmat,eigentrans,rbb,b_size,b_size,b_size,b_size,errorcode);
MatAxB(theta,tempmat,eigenvectors,b_size,b_size,b_size,b_size,errorcode); MatAxB(theta,tempmat,eigenvectors,b_size,b_size,b_size,b_size,errorcode);
for j := 1 to b_size do for j := 1 to b_size do
@ -443,24 +467,21 @@ begin
end; end;
// Print remaining results // Print remaining results
OutputFrm.RichEdit.Lines.Add(''); lReport.Add(' Canonical R Root % Trace Chi-Sqr D.F. Prob. ');
OutputFrm.RichEdit.Lines.Add(''); lReport.Add('-- ----------- -------- --------- --------- ---- --------');
outline := ' Canonical R Root % Trace Chi-Sqr D.F. Prob.';
OutputFrm.RichEdit.Lines.Add(outline);
for i := 1 to b_size do for i := 1 to b_size do
begin lReport.Add('%2d %11.6f %8.3f %9.3f %9.3f %4d %8.3f',
outline := format('%2d %10.6f %8.3f %7.3f %8.3f %2d %8.3f', [i, sqrt(roots[i-1]), roots[i-1], pcnt_trace[i-1], root_chi[i-1], root_df[i-1], chi_prob[i-1]]
[i, sqrt(roots[i-1]), roots[i-1], pcnt_trace[i-1], root_chi[i-1], root_df[i-1], chi_prob[i-1]]); );
OutputFrm.RichEdit.Lines.Add(outline);
end;
chisqr := -ln(Lambda) * (count - 1.0 - 0.5 * (a_size + b_size - 1.0)); chisqr := -ln(Lambda) * (count - 1.0 - 0.5 * (a_size + b_size - 1.0));
chiprob := 1.0 - chisquaredprob(chisqr,a_size * b_size); chiprob := 1.0 - chisquaredprob(chisqr,a_size * b_size);
OutputFrm.RichEdit.Lines.Add(''); lReport.Add('');
OutputFrm.RichEdit.Lines.Add('Overall Tests of Significance:'); lReport.Add('Overall Tests of Significance:');
OutputFrm.RichEdit.Lines.Add(' Statistic Approx. Stat. Value D.F. Prob.>Value'); lReport.Add('');
outline := format('Wilk''s Lambda Chi-Squared %10.4f %3d %6.4f', lReport.Add(' Statistic Approx. Stat. Value D.F. Prob > Value');
[chisqr,a_size * b_size,chiprob]); lReport.Add('------------------------- -------------- ---------- ----- ------------');
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('Wilk''s Lambda Chi-Squared %10.4f %3d %12.4f', [chisqr, a_size * b_size, chiprob]);
s := b_size; s := b_size;
m := 0.5 * (a_size - b_size - 1); m := 0.5 * (a_size - b_size - 1);
n := 0.5 * (count - b_size - a_size - 2); n := 0.5 * (count - b_size - a_size - 2);
@ -468,80 +489,88 @@ begin
df1 := s * (2.0 * m + s + 1.0); df1 := s * (2.0 * m + s + 1.0);
df2 := 2.0 * ( s * n + 1.0); df2 := 2.0 * ( s * n + 1.0);
ftestprob := probf(f,df1,df2); ftestprob := probf(f,df1,df2);
outline := format('Hotelling-Lawley Trace F-Test %10.4f %2.0f %2.0f %6.4f', lReport.Add('Hotelling-Lawley Trace F-Test %10.4f %2.0f %2.0f %12.4f', [f, df1,df2, ftestprob]);
[f, df1,df2, ftestprob]);
OutputFrm.RichEdit.Lines.Add(outline);
df2 := s * (2.0 * n + s + 1.0); df2 := s * (2.0 * n + s + 1.0);
f := (Pillia / (s - Pillia)) * ( (2.0 * n + s +1.0) / (2.0 * m + s + 1.0) ); f := (Pillia / (s - Pillia)) * ( (2.0 * n + s +1.0) / (2.0 * m + s + 1.0) );
ftestprob := probf(f,df1,df2); ftestprob := probf(f,df1,df2);
outline := format('Pillai Trace F-Test %10.4f %2.0f %2.0f %6.4f', lReport.Add('Pillai Trace F-Test %10.4f %2.0f %2.0f %12.4f', [f, df1,df2, ftestprob]);
[f, df1,df2, ftestprob]);
OutputFrm.RichEdit.Lines.Add(outline);
Roys := Roys * (count - 1 - a_size + b_size)/ a_size ; Roys := Roys * (count - 1 - a_size + b_size)/ a_size ;
df1 := a_size; df1 := a_size;
df2 := count - 1 - a_size + b_size; df2 := count - 1 - a_size + b_size;
ftestprob := probf(Roys,df1,df2); ftestprob := probf(Roys,df1,df2);
outline := format('Roys Largest Root F-Test %10.4f %2.0f %2.0f %6.4f', lReport.Add('Roys Largest Root F-Test %10.4f %2.0f %2.0f %12.4f', [Roys, df1, df2, ftestprob]);
[Roys, df1, df2, ftestprob]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
OutputFrm.ShowModal; lReport.Add(SEPARATOR);
OutputFrm.RichEdit.Clear; lReport.Add('');
if EigenChk.Checked then if EigenChk.Checked then
begin begin
title := 'Eigenvectors'; title := 'Eigenvectors';
MAT_PRINT(eigenvectors,b_size,b_size,title,CanLabels,CanLabels,NCases); MatPrint(eigenvectors, b_size, b_size, title, CanLabels, CanLabels, NCases, lReport);
OutputFrm.ShowModal(); lReport.Add('');
OutputFrm.RichEdit.Clear; lReport.Add(SEPARATOR);
lReport.Add('');
end; end;
title := 'Standardized Right Side Weights'; title := 'Standardized Right Side Weights';
MAT_PRINT(norm_a,a_size,b_size,title,RowLabels,CanLabels,NCases); MatPrint(norm_a, a_size, b_size, title, RowLabels, CanLabels, NCases, lReport);
title := 'Standardized Left Side Weights'; title := 'Standardized Left Side Weights';
MAT_PRINT(norm_b,b_size,b_size,title,ColLabels,CanLabels,NCases); MatPrint(norm_b, b_size, b_size, title, ColLabels, CanLabels, NCases, lReport);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear; lReport.Add('');
lReport.Add(SEPARATOR);
lReport.Add('');
title := 'Raw Right Side Weights'; title := 'Raw Right Side Weights';
MAT_PRINT(raw_a,a_size,b_size,title,RowLabels,CanLabels,NCases); MatPrint(raw_a, a_size, b_size, title, RowLabels, CanLabels, NCases, lReport);
title := 'Raw Left Side Weights'; title := 'Raw Left Side Weights';
MAT_PRINT(raw_b,b_size,b_size,title,ColLabels,CanLabels,NCases); MatPrint(raw_b, b_size, b_size, title, ColLabels, CanLabels, NCases, lReport);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear; lReport.Add('');
lReport.Add(SEPARATOR);
lReport.Add('');
title := 'Right Side Correlations with Function'; title := 'Right Side Correlations with Function';
MAT_PRINT(a_cors,a_size,b_size,title,RowLabels,CanLabels,NCases); MatPrint(a_cors, a_size, b_size, title, RowLabels, CanLabels, NCases, lReport);
title := 'Left Side Correlations with Function'; title := 'Left Side Correlations with Function';
MAT_PRINT(b_cors,b_size,b_size,title,ColLabels,CanLabels,NCases); MatPrint(b_cors, b_size, b_size, title, ColLabels, CanLabels, NCases, lReport);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear; lReport.Add('');
lReport.Add(SEPARATOR);
lReport.Add('');
if RedundChk.Checked then if RedundChk.Checked then
begin begin
outline := 'Redundancy Analysis for Right Side Variables'; lReport.Add('Redundancy Analysis for Right Side Variables');
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
OutputFrm.RichEdit.Lines.Add(''); lReport.Add(' Variance Prop. Redundancy ');
outline := ' Variance Prop. Redundancy'; lReport.Add('---------- --------------- ---------------');
OutputFrm.RichEdit.Lines.Add(outline);
for i := 1 to b_size do for i := 1 to b_size do
begin lReport.Add('%8d %15.5f %12.5f', [i, pv_a[i-1], rd_a[i-1]]);
outline := format('%10d %10.5f %10.5f',[i,pv_a[i-1],rd_a[i-1]]); lReport.Add('');
OutputFrm.RichEdit.Lines.Add(outline);
end; lReport.Add('Redundancy Analysis for Left Side Variables');
OutputFrm.RichEdit.Lines.Add(''); lReport.Add('');
outline := 'Redundancy Analysis for Left Side Variables'; lReport.Add(' Variance Prop. Redundancy ');
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('---------- --------------- ------------');
outline := ' Variance Prop. Redundancy';
OutputFrm.RichEdit.Lines.Add(outline);
for i := 1 to b_size do for i := 1 to b_size do
begin lReport.Add('%8d %15.5f %12.5f', [i, pv_b[i-1], rd_b[i-1]]);
outline := format('%10d %10.5f %10.5f',[i,pv_b[i-1],rd_b[i-1]]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
end; lReport.Add(SEPARATOR);
OutputFrm.ShowModal; lReport.Add('');
OutputFrm.RichEdit.Clear;
end; end;
//------------- Now, clean up memory mess ---------------------------- DisplayReport(lReport);
cleanup:
finally
lReport.Free;
Selected := nil; Selected := nil;
ColLabels := nil; ColLabels := nil;
RowLabels := nil; RowLabels := nil;
@ -580,38 +609,59 @@ cleanup:
rab := nil; rab := nil;
rbb := nil; rbb := nil;
raa := nil; raa := nil;
end;
end; end;
procedure TCannonFrm.LeftInClick(Sender: TObject); procedure TCannonFrm.LeftInClick(Sender: TObject);
VAR i, index : integer; var
i: integer;
begin begin
index := VarList.Items.Count;
i := 0; i := 0;
while i < index do while i < VarList.Items.Count do
begin begin
if (VarList.Selected[i]) then if VarList.Selected[i] then
begin begin
LeftList.Items.Add(VarList.Items.Strings[i]); LeftList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i); VarList.Items.Delete(i);
index := index - 1;
i := 0; i := 0;
end end else
else i := i + 1; i := i + 1;
end; end;
LeftOut.Enabled := true; UpdateBtnStates;
end; end;
procedure TCannonFrm.LeftOutClick(Sender: TObject); procedure TCannonFrm.LeftOutClick(Sender: TObject);
VAR index : integer; var
i: integer;
begin begin
index := LeftList.ItemIndex; i := 0;
if index < 0 then while i < LeftList.Items.Count do
begin begin
LeftOut.Enabled := false; if LeftList.Selected[i] then
exit; begin
VarList.Items.Add(LeftList.Items[i]);
LeftList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end; end;
VarList.Items.Add(LeftList.Items.Strings[index]); UpdateBtnStates;
LeftList.Items.Delete(index); end;
procedure TCannonFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TCannonFrm.UpdateBtnStates;
var
lSelected: Boolean;
begin
lSelected := AnySelected(Varlist);
LeftIn.Enabled := lSelected;
RightIn.Enabled := lSelected;
LeftOut.Enabled := AnySelected(LeftList);
RightOut.Enabled := AnySelected(RightList);
end; end;
initialization initialization