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

LazStats: Refactor HierarchUnit. Some clean-up.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7369 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-10 21:56:25 +00:00
parent 44a49b43bd
commit 93146b63ea
9 changed files with 434 additions and 468 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.

16
applications/lazstats/source/forms/analysis/comparisons/glmunit.pas
View File

@ -1541,13 +1541,11 @@ var
block, i, j, k, NEntered, index, noblocks, priorentered : integer;
cellstring : string;
labelstr : string;
outline : string;
R, R2Increment, SSx, sum, constant, FullR2 : double;
df1, df2, F, FProbF, StdErrB,OldDF1, PredSS, PredMS : double;
df1, df2, F, FProbF, StdErrB, PredSS, PredMS : double;
SSt, VarEst, SSres, StdErrEst, AdjR2 : double;
begin
NEntered := 0;
OldDF1 := 0.0;
priorentered := 0;
OldR2 := 0;
@ -2272,20 +2270,18 @@ end;
procedure TGLMFrm.ModelIIIAnalysis(AReport: TStrings);
var
block, i, j, NEntered, index, noblocks, priorentered : integer;
block, i, j, NEntered, index, noblocks: integer;
cellstring : string;
labelstr : string;
outline, effstr : string;
effstr : string;
R, SSx, sum, constant: double;
df1, df2, F, FProbF, StdErrB, OldDF1: double;
df1, df2, F, FProbF, StdErrB: double;
SSt, VarEst, SSres, StdErrEst, AdjR2 : double;
dfbetween, dferrbetween, dfwithin, dferrwithin : double;
ssbetween, sserrbetween, mserrbetween, sswithin, sserrwithin, mserrwithin : double;
betweenblock : integer;
totalss, totaldf : double;
begin
OldDF1 := 0.0;
priorentered := 0;
OldR2 := 0;
ColSelected[0] := ReptDepPos[0];
Labels[0] := GenLabels[1];
@ -2979,7 +2975,7 @@ var
s, m, n, df1, df2, q, w, pcnt_extracted, trace : double;
minroot, critical_prob, Lambda, Pillia : double;
chisqr, HLTrace, chiprob, ftestprob, Roys, f, Hroot : double;
raa, rbb, rab, rba, bigmat, prod, first_prod, second_prod : DblDyneMat;
raa, rbb, rab, rba, bigmat, first_prod, second_prod : DblDyneMat;
char_equation, raainv, rbbinv, eigenvectors, norm_a, norm_b : DblDyneMat;
raw_a, raw_b, a_cors, b_cors, eigentrans, theta, tempmat : DblDyneMat;
mean, variance, stddev, roots, root_chi, chi_prob, pv_a, pv_b : DblDyneVec;
@ -3016,7 +3012,6 @@ begin
SetLength(rab,NLeft+1,NRight+1);
SetLength(rba,NRight+1,NLeft+1);
SetLength(bigmat,novars+1,novars+1);
SetLength(prod,novars+1,novars+1);
SetLength(first_prod,novars+1,novars+1);
SetLength(second_prod,novars+1,novars+1);
SetLength(char_equation,novars+1,novars+1);
@ -3401,7 +3396,6 @@ cleanup:
char_equation := nil;
second_prod := nil;
first_prod := nil;
prod := nil;
bigmat := nil;
rba := nil;
rab := nil;

24
applications/lazstats/source/forms/analysis/multivariate/discrimunit.pas
View File

@ -169,17 +169,17 @@ var
Title : string;
GrpVar, NoGrps, nowithin, TotalCases, value, grpno : integer;
ColNoSelected : IntDyneVec;
CaseNo, NoInGrp : IntDyneVec;
NoInGrp : IntDyneVec;
VarLabels, ColLabels, GrpNos : StrDyneVec;
X, Y, GroupSS, ErrorSS, GroupMS, ErrorMS, TotalSS, num, s, v2, den : double;
Lambda, ChiSquare, Pillia, TotChi, p, Rc, chi, chiprob, m, L2, F, Fprob : double;
DFGroup, DFError, DFTotal, Fratio, prob, minroot, trace, pcnttrace : double;
probchi : double;
WithinMat, WithinInv, WinvB, v, PooledW, TotalMat, BetweenMat : DblDyneMat;
WithinMat, WithinInv, WinvB, PooledW, TotalMat, BetweenMat : DblDyneMat;
EigenVectors, EigenTrans, TempMat, Theta, DiagMat, CoefMat : DblDyneMat;
RawCMat, GrpMeans, GrpSDevs, Centroids, Structure : DblDyneMat;
Constants, ScoreVar, Roots, Pcnts, TotalMeans, TotalVariances : DblDyneVec;
TotalStdDevs, WithinMeans, WithinVariances, WithinStdDevs, w : DblDyneVec;
TotalStdDevs, WithinMeans, WithinVariances, WithinStdDevs: DblDyneVec;
errorcode : boolean = false;
lReport: TStrings;
begin
@ -194,6 +194,13 @@ begin
exit;
end;
if ClassSizeGroup.ItemIndex = -1 then
begin
ClassSizeGroup.SetFocus;
MessageDlg('"Classify Using" is not specified.', mtError, [mbOk], 0);
exit;
end;
TotalCases := 0;
lReport := TStringList.Create;
@ -208,7 +215,6 @@ begin
SetLength(ColNoSelected,NoVariables);
SetLength(VarLabels,NoVariables);
SetLength(ColLabels,NoVariables);
SetLength(CaseNo,NoVariables);
// Get items selected
for i := 1 to NoSelected - 1 do
@ -233,7 +239,6 @@ begin
SetLength(WithinMat,NoVariables,NoVariables);
SetLength(WithinInv,NoVariables,NoVariables);
SetLength(WinvB,NoVariables,NoVariables);
SetLength(v,NoVariables,NoVariables);
SetLength(PooledW,NoVariables,NoVariables);
SetLength(TotalMat,NoVariables,NoVariables);
SetLength(BetweenMat,NoVariables,NoVariables);
@ -255,7 +260,6 @@ begin
SetLength(WithinMeans,NoVariables);
SetLength(WithinVariances,NoVariables);
SetLength(WithinStdDevs,NoVariables);
SetLength(w,NoVariables);
// Initialize arrays
for i := 0 to NoSelected-1 do
@ -782,7 +786,6 @@ begin
Centroids := nil;
GrpSDevs := nil;
GrpMeans := nil;
w := nil;
WithinStdDevs := nil;
WithinVariances := nil;
WithinMeans := nil;
@ -804,11 +807,9 @@ begin
BetweenMat := nil;
TotalMat := nil;
PooledW := nil;
v := nil;
WinvB := nil;
WithinInv := nil;
WithinMat := nil;
CaseNo := nil;
ColLabels := nil;
VarLabels := nil;
end;
@ -984,7 +985,6 @@ procedure TDiscrimFrm.Classify(Sender: TObject; PooledW: DblDyneMat;
VarLabels: StrDyneVec; AReport: TStrings);
var
i, j, k, grp : integer;
outline : string;
Constant, T : DblDyneVec;
S : double;
Coeff, WithinInv : DblDyneMat;
@ -1041,7 +1041,7 @@ var
i, j, k, grp, j1, InGrp, Largest, SecdLarge, oldcolcnt, linecount : integer;
numberstr, prompt, outline, cellname : string;
Table : IntDyneMat;
ProdVec, Dev, D2, Density, ProbGrp, Apriori, Discrim : DblDyneVec;
ProdVec, Dev, D2, ProbGrp, Apriori, Discrim : DblDyneVec;
SumD2, Determinant, LargestProb, SecdProb, X : double;
RowLabels, ColLabels : StrDyneVec;
WithinInv : DblDyneMat;
@ -1054,7 +1054,6 @@ begin
SetLength(ProdVec,NoSelected);
SetLength(Dev,NoSelected);
SetLength(D2,NoGrps);
SetLength(Density,NoGrps);
SetLength(ProbGrp,NoGrps);
SetLength(Apriori,NoGrps);
SetLength(Discrim,noroots);
@ -1253,7 +1252,6 @@ begin
Discrim := nil;
Apriori := nil;
ProbGrp := nil;
Density := nil;
D2 := nil;
Dev := nil;
ProdVec := nil;

37
applications/lazstats/source/forms/analysis/multivariate/factorunit.pas
View File

@ -138,11 +138,11 @@ procedure TFactorFrm.ComputeBtnClick(Sender: TObject);
label again;
var
i, j, k, L, Nroots, noiterations, NoSelected, factorchoice : integer;
maxiters, prtopts, maxnoroots, count : integer;
TempMat, V, corrmat, ainverse, Loadings : DblDyneMat;
Eigenvector, pcnttrace, b, communality, xvector, yvector, d2 : DblDyneVec;
means, variances, stddevs, W : DblDyneVec;
MaxRoot, criterion, Difference, minroot, maxk, trace : double;
maxiters, maxnoroots, count : integer;
TempMat, corrmat, ainverse, Loadings : DblDyneMat;
Eigenvector, b, communality, xvector, yvector, d2 : DblDyneVec;
means, variances, stddevs: DblDyneVec;
criterion, Difference, minroot, trace : double;
cellstring, outline, xtitle, ytitle : string;
ColNoSelected : IntDyneVec;
RowLabels, ColLabels : StrDyneVec;
@ -161,25 +161,12 @@ begin
exit;
end;
MaxRoot := 0.0;
NoIterations := 0;
MaxNoRoots := 0;
PrtOpts := 0;
criterion := 0.0001; //Convergence of communality estimates
//factorchoice := 1; // assume principal component
factorChoice := TypeGroup.ItemIndex + 1;
{
if (TypeGroup.ItemIndex = 1) then factorchoice := 2;
if (TypeGroup.ItemIndex = 2) then factorchoice := 3;
if (TypeGroup.ItemIndex = 3) then factorchoice := 4;
if (TypeGroup.ItemIndex = 4) then factorchoice := 5;
if (TypeGroup.ItemIndex = 5) then factorchoice := 6;
if (TypeGroup.ItemIndex = 6) then factorchoice := 7;
}
if RMatBtn.Checked then prtopts := 3; // wp: why changed in next line?
if RMatBtn.Checked then prtopts := 2;
if RMatBtn.Checked and DescBtn.Checked then prtopts := 1;
maxiters := StrToInt(MaxItersEdit.Text);
if (MaxFactorsEdit.Text <> '') then
MaxNoRoots := StrToInt(MaxFactorsEdit.Text);
@ -203,12 +190,9 @@ begin
SetLength(corrmat, NoVariables + 1, NoVariables + 1);
SetLength(TempMat, NoVariables, NoVariables);
SetLength(ainverse, NoVariables, NoVariables);
SetLength(V, NoVariables, NoVariables);
SetLength(W, NoVariables);
SetLength(Loadings, NoVariables, NoVariables);
SetLength(Eigenvector, NoVariables);
SetLength(communality, NoVariables);
SetLength(pcnttrace, NoVariables);
SetLength(b, NoVariables);
SetLength(d2, NoVariables);
SetLength(xvector, NoVariables);
@ -290,7 +274,6 @@ begin
MatSave(corrmat, NoSelected, NoSelected, means, stddevs, count, RowLabels, ColLabels, filename);
end;
end;
maxk := k;
Nroots := k;
//not a principal component analysis
@ -688,12 +671,9 @@ again:
xvector := nil;
d2 := nil;
b := nil;
pcnttrace := nil;
communality := nil;
Eigenvector := nil;
Loadings := nil;
W := nil;
V := nil;
ainverse := nil;
TempMat := nil;
corrmat := nil;
@ -1130,7 +1110,6 @@ var
ee, p, sum : double;
A, C, d, v, trans : DblDyneMat;
e, f, g, means, stddevs : DblDyneVec;
outline : string;
Title : string;
ColALabels : StrDyneVec ;
filename : string;
@ -1382,7 +1361,7 @@ procedure TFactorFrm.QuartiMax(const v: DblDyneMat; n1, n2: integer;
AReport: TStrings);
var
i, j, M, N, minuscount, NoIters : integer;
A, b, C : DblDyneVec;
A, b: DblDyneVec;
High_Factor : IntDyneVec;
c4, s1, Q, NewQ, TotalPercent, t : double;
theta, tan4theta, ssqrp, ssqrj, prodjp, numerator, denominator : double;
@ -1391,7 +1370,6 @@ var
begin
SetLength(A,NoVariables);
SetLength(b,NoVariables);
SetLength(C,NoVariables);
SetLength(High_Factor,NoVariables);
NoIters := 0;
@ -1554,7 +1532,6 @@ begin
AReport.Add('');
High_Factor := nil;
C := nil;
b := nil;
A := nil;
end;

75
applications/lazstats/source/forms/analysis/multivariate/hierarchunit.lfm
View File

@ -1,11 +1,11 @@
object HierarchFrm: THierarchFrm
Left = 415
Height = 302
Height = 319
Top = 211
Width = 442
AutoSize = True
Caption = 'Hierarchical Cluster Analysis'
ClientHeight = 302
ClientHeight = 319
ClientWidth = 442
OnActivate = FormActivate
OnCreate = FormCreate
@ -42,7 +42,7 @@ object HierarchFrm: THierarchFrm
AnchorSideRight.Control = PredIn
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 228
Height = 245
Top = 25
Width = 176
Anchors = [akTop, akLeft, akRight, akBottom]
@ -51,6 +51,7 @@ object HierarchFrm: THierarchFrm
BorderSpacing.Right = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0
end
object PredIn: TBitBtn
@ -91,7 +92,7 @@ object HierarchFrm: THierarchFrm
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox1
Left = 228
Height = 45
Height = 62
Top = 25
Width = 206
Anchors = [akTop, akLeft, akRight, akBottom]
@ -99,6 +100,8 @@ object HierarchFrm: THierarchFrm
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 3
end
object GroupBox1: TGroupBox
@ -109,7 +112,7 @@ object HierarchFrm: THierarchFrm
AnchorSideBottom.Control = Bevel1
Left = 228
Height = 175
Top = 78
Top = 95
Width = 206
Anchors = [akRight, akBottom]
AutoSize = True
@ -225,86 +228,68 @@ object HierarchFrm: THierarchFrm
end
end
object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 141
Left = 233
Height = 25
Top = 269
Top = 286
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 = 5
end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 207
Height = 25
Top = 269
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 6
end
object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 281
Left = 295
Height = 25
Top = 269
Top = 286
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 = 7
TabOrder = 6
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 369
Left = 379
Height = 25
Top = 269
Width = 61
Top = 286
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 = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 7
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 253
Top = 270
Width = 442
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine

738
applications/lazstats/source/forms/analysis/multivariate/hierarchunit.pas
View File

@ -1,3 +1,5 @@
// Sample file for testing: cansas.laz, use all variiables.
unit HierarchUnit;
{$mode objfpc}{$H+}
@ -16,9 +18,8 @@ type
THierarchFrm = class(TForm)
Bevel1: TBevel;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
MaxGrps: TEdit;
STDChk: TCheckBox;
ReplaceChk: TCheckBox;
@ -41,9 +42,11 @@ type
procedure PredInClick(Sender: TObject);
procedure PredOutClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private
{ private declarations }
FAutoSized: Boolean;
procedure UpdateBtnStates;
public
{ public declarations }
end;
@ -54,26 +57,26 @@ var
implementation
uses
Math;
Math, Utils;
{ THierarchFrm }
procedure THierarchFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
var
i: integer;
begin
VarList.Clear;
PredList.Clear;
PredOut.Enabled := false;
PredIn.Enabled := true;
StdChk.Checked := false;
ReplaceChk.Checked := false;
StatsChk.Checked := false;
PlotChk.Checked := false;
MaxGrpsChk.Checked := false;
VarChk.Checked := false;
MaxGrps.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
VarList.Clear;
PredList.Clear;
StdChk.Checked := false;
ReplaceChk.Checked := false;
StatsChk.Checked := false;
PlotChk.Checked := false;
MaxGrpsChk.Checked := false;
VarChk.Checked := false;
MaxGrps.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;
procedure THierarchFrm.FormActivate(Sender: TObject);
@ -83,11 +86,10 @@ begin
if FAutoSized then
exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
VarList.Constraints.MinWidth := PredList.Width;
Constraints.MinWidth := Width;
@ -99,8 +101,8 @@ end;
procedure THierarchFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
if GraphFrm = nil then
Application.CreateForm(TGraphFrm, GraphFrm);
end;
procedure THierarchFrm.FormShow(Sender: TObject);
@ -111,84 +113,101 @@ end;
procedure THierarchFrm.ComputeBtnClick(Sender: TObject);
label next1;
var
varlabels, rowlabels : StrDyneVec;
outline, cellstring : string;
i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer;
GrpCnt, Nrows, Ncols, NoSelected, linecount : integer;
w2, k4, k5, L1 : IntDyneVec;
ColSelected : IntDyneVec;
X, Y, d1, x1, MaxError : double;
W, XAxis, YAxis, means, variances, stddevs : DblDyneVec;
Distance : DblDyneMat;
varlabels, rowlabels : StrDyneVec;
cellstring : string;
i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer;
GrpCnt, Nrows, Ncols, NoSelected: integer;
w2, k4, k5, L1 : IntDyneVec;
ColSelected : IntDyneVec;
X, Y, d1, x1, MaxError : double;
W, XAxis, YAxis, means, variances, stddevs : DblDyneVec;
Distance : DblDyneMat;
lReport: TStrings;
begin
MaxError := 0.0;
GrpCnt := 0;
NoSelected := PredList.Items.Count;
if VarChk.Checked = false then
begin
SetLength(w2,NoCases);
SetLength(k4,NoCases);
SetLength(k5,NoCases);
SetLength(L1,NoCases);
SetLength(W,NoSelected);
SetLength(XAxis,NoCases);
SetLength(YAxis,NoCases);
SetLength(means,NoSelected);
SetLength(variances,NoSelected);
SetLength(stddevs,NoSelected);
SetLength(Distance,NoCases,NoCases);
SetLength(varlabels,NoSelected);
SetLength(rowlabels,NoCases);
SetLength(ColSelected,NoSelected);
Ncols := NoSelected;
Nrows := NoCases;
for i := 0 to Ncols - 1 do
begin
cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do
begin
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
begin
varlabels[i] := cellstring;
ColSelected[i] := j;
end;
end;
end;
for i := 0 to NoCases-1 do rowlabels[i] := IntToStr(i);
end
else begin
SetLength(w2,NoSelected);
SetLength(k4,NoSelected);
SetLength(k5,NoSelected);
SetLength(L1,NoSelected);
SetLength(W,NoCases);
SetLength(XAxis,NoSelected);
SetLength(YAxis,NoSelected);
SetLength(means,NoCases);
SetLength(variances,NoCases);
SetLength(stddevs,NoCases);
SetLength(Distance,NoSelected,NoCases);
SetLength(varlabels,NoCases);
SetLength(rowlabels,NoSelected);
SetLength(ColSelected,NoSelected);
Ncols := NoCases;
Nrows := NoSelected;
//Get labels of selected variables
for i := 0 to Nrows - 1 do
begin
cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do
begin
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
begin
ColSelected[i] := j;
rowlabels[i] := cellstring;
end;
end;
end;
for i := 0 to NoCases-1 do varlabels[i] := IntToStr(i);
end;
if MembersChk.Checked then k3 := 1 else k3 := 0;
if MaxGrpsChk.Checked then
begin
if MaxGrps.Text = '' then
begin
MessageDlg('Maximum number of groups not specified.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToInt(MaxGrps.Text, k1) or (k1 < 1) then
begin
Messagedlg('No valid number of groups given.', mtError, [mbOK], 0);
exit;
end;
end;
MaxError := 0.0;
GrpCnt := 0;
NoSelected := PredList.Items.Count;
if not VarChk.Checked then
begin
SetLength(w2,NoCases);
SetLength(k4,NoCases);
SetLength(k5,NoCases);
SetLength(L1,NoCases);
SetLength(W,NoSelected);
SetLength(XAxis,NoCases);
SetLength(YAxis,NoCases);
SetLength(means,NoSelected);
SetLength(variances,NoSelected);
SetLength(stddevs,NoSelected);
SetLength(Distance,NoCases,NoCases);
SetLength(varlabels,NoSelected);
SetLength(rowlabels,NoCases);
SetLength(ColSelected,NoSelected);
Ncols := NoSelected;
Nrows := NoCases;
for i := 0 to Ncols - 1 do
begin
cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do
begin
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
begin
varlabels[i] := cellstring;
ColSelected[i] := j;
end;
end;
end;
for i := 0 to NoCases-1 do rowlabels[i] := IntToStr(i);
end else
begin
SetLength(w2,NoSelected);
SetLength(k4,NoSelected);
SetLength(k5,NoSelected);
SetLength(L1,NoSelected);
SetLength(W,NoCases);
SetLength(XAxis,NoSelected);
SetLength(YAxis,NoSelected);
SetLength(means,NoCases);
SetLength(variances,NoCases);
SetLength(stddevs,NoCases);
SetLength(Distance,NoSelected,NoCases);
SetLength(varlabels,NoCases);
SetLength(rowlabels,NoSelected);
SetLength(ColSelected,NoSelected);
Ncols := NoCases;
Nrows := NoSelected;
//Get labels of selected variables
for i := 0 to Nrows - 1 do
begin
cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do
begin
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
begin
ColSelected[i] := j;
rowlabels[i] := cellstring;
end;
end;
end;
for i := 0 to NoCases-1 do
varlabels[i] := IntToStr(i);
end;
if MembersChk.Checked then k3 := 1 else k3 := 0;
for j := 0 to Ncols-1 do
begin
@ -199,45 +218,45 @@ begin
if VarChk.Checked = false then
begin
// Get labels of rows
// Get labels of rows
// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i];
// Get data into the distance matrix
count := 0;
for i := 1 to Nrows do
begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1;
for j := 1 to Ncols do
begin
col := ColSelected[j-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]));
means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X;
end;
end;
end
else begin // cluster variables
// Get labels of columns
// Get data into the distance matrix
count := 0;
for i := 1 to Nrows do
begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1;
for j := 1 to Ncols do
begin
col := ColSelected[j-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]));
means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X;
end;
end;
end else
begin // cluster variables
// Get labels of columns
// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[i,0];
// Get data into the distance matrix
count := 0;
for i := 1 to Nrows do // actually grid column in this case
begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1;
for j := 1 to Ncols do // actually grid rows in this case
begin
// if (not GoodRecord(j,NoSelected,ColSelected)) then continue;
col := ColSelected[i-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j]));
means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X;
end;
end;
// Get data into the distance matrix
count := 0;
for i := 1 to Nrows do // actually grid column in this case
begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1;
for j := 1 to Ncols do // actually grid rows in this case
begin
// if (not GoodRecord(j,NoSelected,ColSelected)) then continue;
col := ColSelected[i-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j]));
means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X;
end;
end;
end;
// Calculate means and standard deviations of variables
@ -250,266 +269,263 @@ begin
end;
// Ready the output form
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('Hierarchical Cluster Analysis');
OutputFrm.RichEdit.Lines.Add('');
outline := format('Number of objects to cluster := %d on %d variables.',
[Nrows, Ncols]);
OutputFrm.RichEdit.Lines.Add(outline);
linecount := 3;
if (StatsChk.Checked) then
begin
DynVectorPrint(means,Ncols,'Variable Means',varlabels,count);
DynVectorPrint(variances,Ncols,'Variable Variances',varlabels,count);
DynVectorPrint(stddevs,Ncols,'Variable Standard Deviations',varlabels,count);
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
linecount := 0;
end;
lReport := TStringList.Create;
try
lReport.Add('HIERARCHICAL CLUSTER ANALYSIS');
lReport.Add('');
lReport.Add('Number of objects to cluster: %d on %d variables.', [Nrows, Ncols]);
lReport.Add('');
// Standardize the distance scores if elected
if (StdChk.Checked) then
begin
for j := 0 to Ncols-1 do
for i := 0 to Nrows-1 do
Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j];
end;
if StatsChk.Checked then
begin
DynVectorPrint(means, Ncols, 'Variable Means', varlabels, count, lReport);
DynVectorPrint(variances, Ncols, 'Variable Variances', varlabels, count, lReport);
DynVectorPrint(stddevs, Ncols, 'Variable Standard Deviations', varlabels, count, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
if (ReplaceChk.Checked) then // replace original values in grid with z scores if elected
begin
// Standardize the distance scores if elected
if StdChk.Checked then
begin
for j := 0 to Ncols-1 do
for i := 0 to Nrows-1 do
Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j];
end;
// replace original values in grid with z scores if elected
if ReplaceChk.Checked then
begin
for i := 1 to Nrows do
begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
if not GoodRecord(i,NoSelected,ColSelected) then continue;
for j := 1 to Ncols do
begin
col := ColSelected[j-1];
outline := format('%6.4f',[Distance[i-1,j-1]]);
OS3MainFrm.DataGrid.Cells[col,i] := outline;
OS3MainFrm.DataGrid.Cells[col,i] := Format('%6.4f', [Distance[i-1,j-1]]);
end;
end;
end;
end;
// Convert data matrix to initial matrix of error potentials
for i := 1 to Nrows do
begin
// Convert data matrix to initial matrix of error potentials
for i := 1 to Nrows do
begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
for j := 1 to Ncols do W[j-1] := Distance[i-1,j-1];
for j := i to Nrows do
begin
for j := 1 to Ncols do
W[j-1] := Distance[i-1,j-1];
for j := i to Nrows do
begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
Distance[i-1,j-1] := 0.0;
for k := 1 to Ncols do Distance[i-1,j-1] := Distance[i-1,j-1] +
(Distance[j-1,k-1] - W[k-1]) * (Distance[j-1,k-1] - W[k-1]);
Distance[i-1,j-1] := Distance[i-1,j-1] / 2.0;
end;
end;
for i := 1 to Nrows do
for j := i to Nrows do Distance[j-1,i-1] := 0.0;
// Now, group the cases for maximum groups down
if MaxGrpsChk.Checked then
begin
k1 := StrToInt(MaxGrps.Text);
n3 := Nrows;
end
else begin
k1 := 2;
n3 := Nrows;
end;
// Initialize group membership and group-n vectors
for i := 0 to Nrows-1 do
begin
k4[i] := i+1;
k5[i] := i+1;
w2[i] := 1;
end;
// Locate optimal combination, if more than 2 groups remain
next1:
n3 := n3 - 1;
if (n3 > 1) then
begin
x1 := 100000000000.0;
for i := 1 to Nrows do
begin
if (k5[i-1] = i) then
begin
for j := i to Nrows do
begin
if ((i <> j) and (k5[j-1] = j)) then
begin
d1 := Distance[i-1,j-1] - Distance[i-1,i-1] - Distance[j-1,j-1];
if (d1 < x1) then
begin
x1 := d1;
L := i;
M := j;
end; // end if
end; // end if
end; // next j
end; // end if
end; // next i
n4 := w2[L-1];
n5 := w2[M-1];
OutputFrm.RichEdit.Lines.Add('');
linecount := linecount + 1;
GrpCnt := GrpCnt + 1;
XAxis[GrpCnt-1] := n3;
YAxis[GrpCnt-1] := x1;
if (x1 > MaxError) then MaxError := x1;
outline := format('%d groups after combining group %d (n := %d ) and group %d (n := %d) error := %7.3f',
[n3, L, n4, M, n5, x1]);
OutputFrm.RichEdit.Lines.Add(outline);
linecount := linecount + 1;
if (linecount >= 60) then
begin
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
linecount := 0;
end;
w3 := w2[L-1] + w2[M-1];
x1 := Distance[L-1,M-1] * w3;
Y := Distance[L-1,L-1] * w2[L-1] + Distance[M-1,M-1] * w2[M-1];
Distance[L-1,L-1] := Distance[L-1,M-1];
for i := 1 to Nrows do
if (k5[i-1] = M) then k5[i-1] := L;
for i := 1 to Nrows do
begin
if ((i <> L) and (k5[i-1] = i)) then
begin
if (i <= L) then
begin
Distance[i-1,L-1] := Distance[i-1,L-1] * (w2[i-1] + w2[L-1])
+ Distance[i-1,M-1] * (w2[i-1] + w2[M-1])
+ x1 - Y - Distance[i-1,i-1] * w2[i-1];
Distance[i-1,L-1] := Distance[i-1,L-1] / (w2[i-1] + w3);
end
else
begin
Distance[L-1,i-1] := Distance[L-1,i-1] * (w2[L-1] + w2[i-1])
+ (Distance[M-1,i-1] + Distance[i-1,M-1]) * (w2[M-1] + w2[i-1]);
Distance[L-1,i-1] := (Distance[L-1,i-1]+ x1 - Y
- Distance[i-1,i-1] * w2[i-1]) / (w2[i-1] + w3);
end;
Distance[i-1,j-1] := 0.0;
for k := 1 to Ncols do
Distance[i-1,j-1] := Distance[i-1,j-1] + (Distance[j-1,k-1] - W[k-1]) * (Distance[j-1,k-1] - W[k-1]);
Distance[i-1,j-1] := Distance[i-1,j-1] / 2.0;
end;
end;
w2[L-1] := w3;
if (n3 > k1) then goto next1;
// print group memberships of all objects, if optioned
for i := 1 to Nrows do
for j := i to Nrows do Distance[j-1,i-1] := 0.0;
// Now, group the cases for maximum groups down
if MaxGrpsChk.Checked then
begin
if (k5[i-1] = i) then
k1 := StrToInt(MaxGrps.Text);
n3 := Nrows;
end else
begin
k1 := 2;
n3 := Nrows;
end;
// Initialize group membership and group-n vectors
for i := 0 to Nrows-1 do
begin
k4[i] := i+1;
k5[i] := i+1;
w2[i] := 1;
end;
// Locate optimal combination, if more than 2 groups remain
next1:
n3 := n3 - 1;
if (n3 > 1) then
begin
x1 := 100000000000.0;
for i := 1 to Nrows do
begin
L := 0;
for j := 1 to Nrows do
if (k5[i-1] = i) then
begin
if (k5[j-1] = i) then
for j := i to Nrows do
begin
L := L + 1;
L1[L-1] := k4[j-1];
if k3 = 1 then L1[L-1] := j;
if ((i <> j) and (k5[j-1] = j)) then
begin
d1 := Distance[i-1,j-1] - Distance[i-1,i-1] - Distance[j-1,j-1];
if (d1 < x1) then
begin
x1 := d1;
L := i;
M := j;
end; // end if
end; // end if
end; // next j
end; // end if
end; // next i
n4 := w2[L-1];
n5 := w2[M-1];
GrpCnt := GrpCnt + 1;
XAxis[GrpCnt-1] := n3;
YAxis[GrpCnt-1] := x1;
if (x1 > MaxError) then MaxError := x1;
lReport.Add('%2.d groups after combining group %2.d (n = %2.d) and group %2.d (n = %2.d), error: %7.3f', [n3, L, n4, M, n5, x1]);
w3 := w2[L-1] + w2[M-1];
x1 := Distance[L-1,M-1] * w3;
Y := Distance[L-1,L-1] * w2[L-1] + Distance[M-1,M-1] * w2[M-1];
Distance[L-1,L-1] := Distance[L-1,M-1];
for i := 1 to Nrows do
if (k5[i-1] = M) then k5[i-1] := L;
for i := 1 to Nrows do
begin
if ((i <> L) and (k5[i-1] = i)) then
begin
if (i <= L) then
begin
Distance[i-1,L-1] := Distance[i-1,L-1] * (w2[i-1] + w2[L-1])
+ Distance[i-1,M-1] * (w2[i-1] + w2[M-1])
+ x1 - Y - Distance[i-1,i-1] * w2[i-1];
Distance[i-1,L-1] := Distance[i-1,L-1] / (w2[i-1] + w3);
end else
begin
Distance[L-1,i-1] := Distance[L-1,i-1] * (w2[L-1] + w2[i-1])
+ (Distance[M-1,i-1] + Distance[i-1,M-1]) * (w2[M-1] + w2[i-1]);
Distance[L-1,i-1] := (Distance[L-1,i-1]+ x1 - Y
- Distance[i-1,i-1] * w2[i-1]) / (w2[i-1] + w3);
end;
end;
if k3 = 1 then
begin
outline := format('Group %d (n := %d)',[i,L]);
OutputFrm.RichEdit.Lines.Add(outline);
outline := '';
for j := 1 to L do
begin
outline := format(' Object := %s',[rowlabels[L1[j-1]-1]]);
OutputFrm.RichEdit.Lines.Add(outline);
linecount := linecount + 1;
end;
if (linecount >= 60) then
begin
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
linecount := 0;
end;
end; // end if
end; // end if
end; // next i
goto next1;
end; // end if
if (linecount > 0) then OutputFrm.ShowModal;
end;
w2[L-1] := w3;
if (n3 > k1) then goto next1;
if (PlotChk.Checked) then
begin
SetLength(GraphFrm.Ypoints,1,GrpCnt);
SetLength(GraphFrm.Xpoints,1,GrpCnt);
for i := 1 to GrpCnt do
begin
GraphFrm.Ypoints[0,i-1] := YAxis[i-1];
GraphFrm.Xpoints[0,i-1] := XAxis[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := GrpCnt;
GraphFrm.Heading := 'NO. GROUPS VERSUS GROUPING ERROR';
GraphFrm.XTitle := 'NO. GROUPS';
GraphFrm.YTitle := 'ERROR';
// print group memberships of all objects, if optioned
for i := 1 to Nrows do
begin
if (k5[i-1] = i) then
begin
L := 0;
for j := 1 to Nrows do
begin
if (k5[j-1] = i) then
begin
L := L + 1;
L1[L-1] := k4[j-1];
if k3 = 1 then L1[L-1] := j;
end;
end;
if k3 = 1 then
begin
lReport.Add('Group %d (n = %d)', [i, L]);
for j := 1 to L do
lReport.Add(' Object: %s', [rowlabels[L1[j-1]-1]]);
end; // end if
end; // end if
end; // next i
goto next1;
end; // end if
DisplayReport(lReport);
if PlotChk.Checked then
begin
SetLength(GraphFrm.Ypoints,1,GrpCnt);
SetLength(GraphFrm.Xpoints,1,GrpCnt);
for i := 1 to GrpCnt do
begin
GraphFrm.Ypoints[0,i-1] := YAxis[i-1];
GraphFrm.Xpoints[0,i-1] := XAxis[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := GrpCnt;
GraphFrm.Heading := 'NO. GROUPS VERSUS GROUPING ERROR';
GraphFrm.XTitle := 'NO. GROUPS';
GraphFrm.YTitle := 'ERROR';
// GraphFrm.Ypoints[1] := YAxis;
// GraphFrm.Xpoints[1] := XAxis;
GraphFrm.AutoScaled := true;
GraphFrm.PtLabels := false;
GraphFrm.GraphType := 7; // 2d points
GraphFrm.BackColor := clYellow;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
end;
GraphFrm.AutoScaled := true;
GraphFrm.PtLabels := false;
GraphFrm.GraphType := 7; // 2d points
GraphFrm.BackColor := clCream;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
end;
// clean up
ColSelected := nil;
rowlabels := nil;
varlabels := nil;
Distance := nil;
stddevs := nil;
variances := nil;
means := nil;
YAxis := nil;
XAxis := nil;
W := nil;
L1 := nil;
k5 := nil;
k4 := nil;
w2 := nil;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
finally
lReport.Free;
ColSelected := nil;
rowlabels := nil;
varlabels := nil;
Distance := nil;
stddevs := nil;
variances := nil;
means := nil;
YAxis := nil;
XAxis := nil;
W := nil;
L1 := nil;
k5 := nil;
k4 := nil;
w2 := nil;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
end;
end;
procedure THierarchFrm.PredInClick(Sender: TObject);
VAR i, index : integer;
var
i: integer;
begin
index := VarList.Items.Count;
i := 0;
while i < index do
begin
if (VarList.Selected[i]) then
begin
PredList.Items.Add(VarList.Items.Strings[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
end;
PredOut.Enabled := true;
i := 0;
while i < VarList.Items.Count do
begin
if VarList.Selected[i] then
begin
PredList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure THierarchFrm.PredOutClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := PredList.ItemIndex;
if index < 0 then
begin
PredOut.Enabled := false;
exit;
end;
VarList.Items.Add(PredList.Items.Strings[index]);
PredList.Items.Delete(index);
i := 0;
while i < PredList.Items.Count do
begin
if PredList.Selected[i] then
begin
VarList.Items.Add(PredList.Items[i]);
PredList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure THierarchFrm.UpdateBtnStates;
begin
PredIn.Enabled := AnySelected(VarList);
PredOut.Enabled := AnySelected(PredList);
end;
procedure THierarchFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
initialization

8
applications/lazstats/source/forms/analysis/multivariate/pathunit.pas
View File

@ -325,12 +325,12 @@ end;
procedure TPathFrm.ComputeBtnClick(Sender: TObject);
var
i, j, k, col, row, NoVars, nocaused, NoSelected, NoIndepVars : integer;
count, IER, noexogenous, t, L: integer;
constant, StdErrEst, ProbOut, R2, Temp, d2, sum, absdiff : double;
count, IER, noexogenous, L: integer;
constant, StdErrEst, ProbOut, R2, d2, sum, absdiff : double;
cellstring: string;
ColNoSelected, selected : IntDyneVec;
IndepIndex : IntDyneVec;
rmat, WorkMat, PathCoef, IndMatrix, InvMatrix, e, W : DblDyneMat;
rmat, WorkMat, PathCoef, IndMatrix, e, W : DblDyneMat;
means, variances, stddevs, beta, p : DblDyneVec;
zvals : DblDyneMat; // z scores for path model
genedz : IntDyneVec; // list of z's created for path models
@ -386,7 +386,6 @@ begin
SetLength(WorkMat,NoVariables+1,NoVariables+1);
SetLength(PathCoef,NoVariables,NoVariables);
SetLength(IndMatrix,NoVariables,NoVariables);
SetLength(InvMatrix,NoVariables,NoVariables);
SetLength(e,NoVariables,NoVariables);
SetLength(W,NoVariables,NoVariables);
SetLength(means,NoVariables);
@ -830,7 +829,6 @@ begin
means := nil;
W := nil;
e := nil;
InvMatrix := nil;
IndMatrix := nil;
PathCoef := nil;
WorkMat := nil;

3
applications/lazstats/source/forms/analysis/nonparametric/kaplanmeierunit.pas
View File

@ -208,7 +208,7 @@ var
Size1, Size2, TotalSize, NoDeaths, ThisTime: integer;
mintime, maxtime, tempint, nopoints, tempvalue : integer;
NoCensored, nocats, i, j, k, icase, oldtime, pos, first, last : integer;
noinexp, noincntrl, count, TimeCol, DeathsCol, CensoredCol : integer;
noinexp, noincntrl, count, TimeCol, DeathsCol: integer;
GroupCol : integer;
cumprop, proportion, term1, term2, term3 : double;
E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double;
@ -227,7 +227,6 @@ begin
DeathsLabel := EventEdit.Text;
TimeCol := 0;
DeathsCol := 0;
CensoredCol := 0;
GroupCol := 0;
for i := 1 to NoVariables do
begin

1
applications/lazstats/source/units/dataprocs.pas
View File

@ -65,7 +65,6 @@ uses MainUnit;
Function GoodRecord(Row, NoVars: integer; const GridPos: IntDyneVec): boolean;
var
i, j: integer;
isgood: boolean;
begin
Result := true;
for i := 1 to NoVars do