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

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

@@ -169,17 +169,17 @@ var
Title : string; Title : string;
GrpVar, NoGrps, nowithin, TotalCases, value, grpno : integer; GrpVar, NoGrps, nowithin, TotalCases, value, grpno : integer;
ColNoSelected : IntDyneVec; ColNoSelected : IntDyneVec;
CaseNo, NoInGrp : IntDyneVec; NoInGrp : IntDyneVec;
VarLabels, ColLabels, GrpNos : StrDyneVec; VarLabels, ColLabels, GrpNos : StrDyneVec;
X, Y, GroupSS, ErrorSS, GroupMS, ErrorMS, TotalSS, num, s, v2, den : double; 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; Lambda, ChiSquare, Pillia, TotChi, p, Rc, chi, chiprob, m, L2, F, Fprob : double;
DFGroup, DFError, DFTotal, Fratio, prob, minroot, trace, pcnttrace : double; DFGroup, DFError, DFTotal, Fratio, prob, minroot, trace, pcnttrace : double;
probchi : 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; EigenVectors, EigenTrans, TempMat, Theta, DiagMat, CoefMat : DblDyneMat;
RawCMat, GrpMeans, GrpSDevs, Centroids, Structure : DblDyneMat; RawCMat, GrpMeans, GrpSDevs, Centroids, Structure : DblDyneMat;
Constants, ScoreVar, Roots, Pcnts, TotalMeans, TotalVariances : DblDyneVec; Constants, ScoreVar, Roots, Pcnts, TotalMeans, TotalVariances : DblDyneVec;
TotalStdDevs, WithinMeans, WithinVariances, WithinStdDevs, w : DblDyneVec; TotalStdDevs, WithinMeans, WithinVariances, WithinStdDevs: DblDyneVec;
errorcode : boolean = false; errorcode : boolean = false;
lReport: TStrings; lReport: TStrings;
begin begin
@@ -194,6 +194,13 @@ begin
exit; exit;
end; end;
if ClassSizeGroup.ItemIndex = -1 then
begin
ClassSizeGroup.SetFocus;
MessageDlg('"Classify Using" is not specified.', mtError, [mbOk], 0);
exit;
end;
TotalCases := 0; TotalCases := 0;
lReport := TStringList.Create; lReport := TStringList.Create;
@@ -208,7 +215,6 @@ begin
SetLength(ColNoSelected,NoVariables); SetLength(ColNoSelected,NoVariables);
SetLength(VarLabels,NoVariables); SetLength(VarLabels,NoVariables);
SetLength(ColLabels,NoVariables); SetLength(ColLabels,NoVariables);
SetLength(CaseNo,NoVariables);
// Get items selected // Get items selected
for i := 1 to NoSelected - 1 do for i := 1 to NoSelected - 1 do
@@ -233,7 +239,6 @@ begin
SetLength(WithinMat,NoVariables,NoVariables); SetLength(WithinMat,NoVariables,NoVariables);
SetLength(WithinInv,NoVariables,NoVariables); SetLength(WithinInv,NoVariables,NoVariables);
SetLength(WinvB,NoVariables,NoVariables); SetLength(WinvB,NoVariables,NoVariables);
SetLength(v,NoVariables,NoVariables);
SetLength(PooledW,NoVariables,NoVariables); SetLength(PooledW,NoVariables,NoVariables);
SetLength(TotalMat,NoVariables,NoVariables); SetLength(TotalMat,NoVariables,NoVariables);
SetLength(BetweenMat,NoVariables,NoVariables); SetLength(BetweenMat,NoVariables,NoVariables);
@@ -255,7 +260,6 @@ begin
SetLength(WithinMeans,NoVariables); SetLength(WithinMeans,NoVariables);
SetLength(WithinVariances,NoVariables); SetLength(WithinVariances,NoVariables);
SetLength(WithinStdDevs,NoVariables); SetLength(WithinStdDevs,NoVariables);
SetLength(w,NoVariables);
// Initialize arrays // Initialize arrays
for i := 0 to NoSelected-1 do for i := 0 to NoSelected-1 do
@@ -782,7 +786,6 @@ begin
Centroids := nil; Centroids := nil;
GrpSDevs := nil; GrpSDevs := nil;
GrpMeans := nil; GrpMeans := nil;
w := nil;
WithinStdDevs := nil; WithinStdDevs := nil;
WithinVariances := nil; WithinVariances := nil;
WithinMeans := nil; WithinMeans := nil;
@@ -804,11 +807,9 @@ begin
BetweenMat := nil; BetweenMat := nil;
TotalMat := nil; TotalMat := nil;
PooledW := nil; PooledW := nil;
v := nil;
WinvB := nil; WinvB := nil;
WithinInv := nil; WithinInv := nil;
WithinMat := nil; WithinMat := nil;
CaseNo := nil;
ColLabels := nil; ColLabels := nil;
VarLabels := nil; VarLabels := nil;
end; end;
@@ -984,7 +985,6 @@ procedure TDiscrimFrm.Classify(Sender: TObject; PooledW: DblDyneMat;
VarLabels: StrDyneVec; AReport: TStrings); VarLabels: StrDyneVec; AReport: TStrings);
var var
i, j, k, grp : integer; i, j, k, grp : integer;
outline : string;
Constant, T : DblDyneVec; Constant, T : DblDyneVec;
S : double; S : double;
Coeff, WithinInv : DblDyneMat; Coeff, WithinInv : DblDyneMat;
@@ -1041,7 +1041,7 @@ var
i, j, k, grp, j1, InGrp, Largest, SecdLarge, oldcolcnt, linecount : integer; i, j, k, grp, j1, InGrp, Largest, SecdLarge, oldcolcnt, linecount : integer;
numberstr, prompt, outline, cellname : string; numberstr, prompt, outline, cellname : string;
Table : IntDyneMat; Table : IntDyneMat;
ProdVec, Dev, D2, Density, ProbGrp, Apriori, Discrim : DblDyneVec; ProdVec, Dev, D2, ProbGrp, Apriori, Discrim : DblDyneVec;
SumD2, Determinant, LargestProb, SecdProb, X : double; SumD2, Determinant, LargestProb, SecdProb, X : double;
RowLabels, ColLabels : StrDyneVec; RowLabels, ColLabels : StrDyneVec;
WithinInv : DblDyneMat; WithinInv : DblDyneMat;
@@ -1054,7 +1054,6 @@ begin
SetLength(ProdVec,NoSelected); SetLength(ProdVec,NoSelected);
SetLength(Dev,NoSelected); SetLength(Dev,NoSelected);
SetLength(D2,NoGrps); SetLength(D2,NoGrps);
SetLength(Density,NoGrps);
SetLength(ProbGrp,NoGrps); SetLength(ProbGrp,NoGrps);
SetLength(Apriori,NoGrps); SetLength(Apriori,NoGrps);
SetLength(Discrim,noroots); SetLength(Discrim,noroots);
@@ -1253,7 +1252,6 @@ begin
Discrim := nil; Discrim := nil;
Apriori := nil; Apriori := nil;
ProbGrp := nil; ProbGrp := nil;
Density := nil;
D2 := nil; D2 := nil;
Dev := nil; Dev := nil;
ProdVec := 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; label again;
var var
i, j, k, L, Nroots, noiterations, NoSelected, factorchoice : integer; i, j, k, L, Nroots, noiterations, NoSelected, factorchoice : integer;
maxiters, prtopts, maxnoroots, count : integer; maxiters, maxnoroots, count : integer;
TempMat, V, corrmat, ainverse, Loadings : DblDyneMat; TempMat, corrmat, ainverse, Loadings : DblDyneMat;
Eigenvector, pcnttrace, b, communality, xvector, yvector, d2 : DblDyneVec; Eigenvector, b, communality, xvector, yvector, d2 : DblDyneVec;
means, variances, stddevs, W : DblDyneVec; means, variances, stddevs: DblDyneVec;
MaxRoot, criterion, Difference, minroot, maxk, trace : double; criterion, Difference, minroot, trace : double;
cellstring, outline, xtitle, ytitle : string; cellstring, outline, xtitle, ytitle : string;
ColNoSelected : IntDyneVec; ColNoSelected : IntDyneVec;
RowLabels, ColLabels : StrDyneVec; RowLabels, ColLabels : StrDyneVec;
@@ -161,25 +161,12 @@ begin
exit; exit;
end; end;
MaxRoot := 0.0;
NoIterations := 0; NoIterations := 0;
MaxNoRoots := 0; MaxNoRoots := 0;
PrtOpts := 0;
criterion := 0.0001; //Convergence of communality estimates criterion := 0.0001; //Convergence of communality estimates
//factorchoice := 1; // assume principal component
factorChoice := TypeGroup.ItemIndex + 1; 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); maxiters := StrToInt(MaxItersEdit.Text);
if (MaxFactorsEdit.Text <> '') then if (MaxFactorsEdit.Text <> '') then
MaxNoRoots := StrToInt(MaxFactorsEdit.Text); MaxNoRoots := StrToInt(MaxFactorsEdit.Text);
@@ -203,12 +190,9 @@ begin
SetLength(corrmat, NoVariables + 1, NoVariables + 1); SetLength(corrmat, NoVariables + 1, NoVariables + 1);
SetLength(TempMat, NoVariables, NoVariables); SetLength(TempMat, NoVariables, NoVariables);
SetLength(ainverse, NoVariables, NoVariables); SetLength(ainverse, NoVariables, NoVariables);
SetLength(V, NoVariables, NoVariables);
SetLength(W, NoVariables);
SetLength(Loadings, NoVariables, NoVariables); SetLength(Loadings, NoVariables, NoVariables);
SetLength(Eigenvector, NoVariables); SetLength(Eigenvector, NoVariables);
SetLength(communality, NoVariables); SetLength(communality, NoVariables);
SetLength(pcnttrace, NoVariables);
SetLength(b, NoVariables); SetLength(b, NoVariables);
SetLength(d2, NoVariables); SetLength(d2, NoVariables);
SetLength(xvector, NoVariables); SetLength(xvector, NoVariables);
@@ -290,7 +274,6 @@ begin
MatSave(corrmat, NoSelected, NoSelected, means, stddevs, count, RowLabels, ColLabels, filename); MatSave(corrmat, NoSelected, NoSelected, means, stddevs, count, RowLabels, ColLabels, filename);
end; end;
end; end;
maxk := k;
Nroots := k; Nroots := k;
//not a principal component analysis //not a principal component analysis
@@ -688,12 +671,9 @@ again:
xvector := nil; xvector := nil;
d2 := nil; d2 := nil;
b := nil; b := nil;
pcnttrace := nil;
communality := nil; communality := nil;
Eigenvector := nil; Eigenvector := nil;
Loadings := nil; Loadings := nil;
W := nil;
V := nil;
ainverse := nil; ainverse := nil;
TempMat := nil; TempMat := nil;
corrmat := nil; corrmat := nil;
@@ -1130,7 +1110,6 @@ var
ee, p, sum : double; ee, p, sum : double;
A, C, d, v, trans : DblDyneMat; A, C, d, v, trans : DblDyneMat;
e, f, g, means, stddevs : DblDyneVec; e, f, g, means, stddevs : DblDyneVec;
outline : string;
Title : string; Title : string;
ColALabels : StrDyneVec ; ColALabels : StrDyneVec ;
filename : string; filename : string;
@@ -1382,7 +1361,7 @@ procedure TFactorFrm.QuartiMax(const v: DblDyneMat; n1, n2: integer;
AReport: TStrings); AReport: TStrings);
var var
i, j, M, N, minuscount, NoIters : integer; i, j, M, N, minuscount, NoIters : integer;
A, b, C : DblDyneVec; A, b: DblDyneVec;
High_Factor : IntDyneVec; High_Factor : IntDyneVec;
c4, s1, Q, NewQ, TotalPercent, t : double; c4, s1, Q, NewQ, TotalPercent, t : double;
theta, tan4theta, ssqrp, ssqrj, prodjp, numerator, denominator : double; theta, tan4theta, ssqrp, ssqrj, prodjp, numerator, denominator : double;
@@ -1391,7 +1370,6 @@ var
begin begin
SetLength(A,NoVariables); SetLength(A,NoVariables);
SetLength(b,NoVariables); SetLength(b,NoVariables);
SetLength(C,NoVariables);
SetLength(High_Factor,NoVariables); SetLength(High_Factor,NoVariables);
NoIters := 0; NoIters := 0;
@@ -1554,7 +1532,6 @@ begin
AReport.Add(''); AReport.Add('');
High_Factor := nil; High_Factor := nil;
C := nil;
b := nil; b := nil;
A := nil; A := nil;
end; end;

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

@@ -1,11 +1,11 @@
object HierarchFrm: THierarchFrm object HierarchFrm: THierarchFrm
Left = 415 Left = 415
Height = 302 Height = 319
Top = 211 Top = 211
Width = 442 Width = 442
AutoSize = True AutoSize = True
Caption = 'Hierarchical Cluster Analysis' Caption = 'Hierarchical Cluster Analysis'
ClientHeight = 302 ClientHeight = 319
ClientWidth = 442 ClientWidth = 442
OnActivate = FormActivate OnActivate = FormActivate
OnCreate = FormCreate OnCreate = FormCreate
@@ -42,7 +42,7 @@ object HierarchFrm: THierarchFrm
AnchorSideRight.Control = PredIn AnchorSideRight.Control = PredIn
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = Bevel1
Left = 8 Left = 8
Height = 228 Height = 245
Top = 25 Top = 25
Width = 176 Width = 176
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@@ -51,6 +51,7 @@ object HierarchFrm: THierarchFrm
BorderSpacing.Right = 8 BorderSpacing.Right = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object PredIn: TBitBtn object PredIn: TBitBtn
@@ -91,7 +92,7 @@ object HierarchFrm: THierarchFrm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GroupBox1 AnchorSideBottom.Control = GroupBox1
Left = 228 Left = 228
Height = 45 Height = 62
Top = 25 Top = 25
Width = 206 Width = 206
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@@ -99,6 +100,8 @@ object HierarchFrm: THierarchFrm
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
@@ -109,7 +112,7 @@ object HierarchFrm: THierarchFrm
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = Bevel1
Left = 228 Left = 228
Height = 175 Height = 175
Top = 78 Top = 95
Width = 206 Width = 206
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
@@ -225,86 +228,68 @@ object HierarchFrm: THierarchFrm
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 = 141 Left = 233
Height = 25 Height = 25
Top = 269 Top = 286
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 = 5 TabOrder = 5
end 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 object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 281 Left = 295
Height = 25 Height = 25
Top = 269 Top = 286
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 = 7 TabOrder = 6
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 = 369 Left = 379
Height = 25 Height = 25
Top = 269 Top = 286
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 = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Return' Caption = 'Close'
ModalResult = 1 ModalResult = 11
TabOrder = 8 TabOrder = 7
end end
object Bevel1: TBevel object Bevel1: TBevel
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 = 253 Top = 270
Width = 442 Width = 442
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine 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; unit HierarchUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@@ -16,9 +18,8 @@ type
THierarchFrm = class(TForm) THierarchFrm = class(TForm)
Bevel1: TBevel; Bevel1: TBevel;
ResetBtn: TButton; ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
ReturnBtn: TButton; CloseBtn: TButton;
MaxGrps: TEdit; MaxGrps: TEdit;
STDChk: TCheckBox; STDChk: TCheckBox;
ReplaceChk: TCheckBox; ReplaceChk: TCheckBox;
@@ -41,9 +42,11 @@ type
procedure PredInClick(Sender: TObject); procedure PredInClick(Sender: TObject);
procedure PredOutClick(Sender: TObject); procedure PredOutClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(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;
@@ -54,26 +57,26 @@ var
implementation implementation
uses uses
Math; Math, Utils;
{ THierarchFrm } { THierarchFrm }
procedure THierarchFrm.ResetBtnClick(Sender: TObject); procedure THierarchFrm.ResetBtnClick(Sender: TObject);
VAR i : integer; var
i: integer;
begin begin
VarList.Clear; VarList.Clear;
PredList.Clear; PredList.Clear;
PredOut.Enabled := false; StdChk.Checked := false;
PredIn.Enabled := true; ReplaceChk.Checked := false;
StdChk.Checked := false; StatsChk.Checked := false;
ReplaceChk.Checked := false; PlotChk.Checked := false;
StatsChk.Checked := false; MaxGrpsChk.Checked := false;
PlotChk.Checked := false; VarChk.Checked := false;
MaxGrpsChk.Checked := false; MaxGrps.Text := '';
VarChk.Checked := false; for i := 1 to NoVariables do
MaxGrps.Text := ''; VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
for i := 1 to NoVariables do UpdateBtnStates;
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end; end;
procedure THierarchFrm.FormActivate(Sender: TObject); procedure THierarchFrm.FormActivate(Sender: TObject);
@@ -83,11 +86,10 @@ begin
if FAutoSized then if FAutoSized then
exit; exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
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;
VarList.Constraints.MinWidth := PredList.Width; VarList.Constraints.MinWidth := PredList.Width;
Constraints.MinWidth := Width; Constraints.MinWidth := Width;
@@ -99,8 +101,8 @@ end;
procedure THierarchFrm.FormCreate(Sender: TObject); procedure THierarchFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then if GraphFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm); Application.CreateForm(TGraphFrm, GraphFrm);
end; end;
procedure THierarchFrm.FormShow(Sender: TObject); procedure THierarchFrm.FormShow(Sender: TObject);
@@ -111,84 +113,101 @@ end;
procedure THierarchFrm.ComputeBtnClick(Sender: TObject); procedure THierarchFrm.ComputeBtnClick(Sender: TObject);
label next1; label next1;
var var
varlabels, rowlabels : StrDyneVec; varlabels, rowlabels : StrDyneVec;
outline, cellstring : string; cellstring : string;
i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer; i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer;
GrpCnt, Nrows, Ncols, NoSelected, linecount : integer; GrpCnt, Nrows, Ncols, NoSelected: integer;
w2, k4, k5, L1 : IntDyneVec; w2, k4, k5, L1 : IntDyneVec;
ColSelected : IntDyneVec; ColSelected : IntDyneVec;
X, Y, d1, x1, MaxError : double; X, Y, d1, x1, MaxError : double;
W, XAxis, YAxis, means, variances, stddevs : DblDyneVec; W, XAxis, YAxis, means, variances, stddevs : DblDyneVec;
Distance : DblDyneMat; Distance : DblDyneMat;
lReport: TStrings;
begin begin
MaxError := 0.0; if MaxGrpsChk.Checked then
GrpCnt := 0; begin
NoSelected := PredList.Items.Count; if MaxGrps.Text = '' then
if VarChk.Checked = false then begin
begin MessageDlg('Maximum number of groups not specified.', mtError, [mbOK], 0);
SetLength(w2,NoCases); exit;
SetLength(k4,NoCases); end;
SetLength(k5,NoCases); if not TryStrToInt(MaxGrps.Text, k1) or (k1 < 1) then
SetLength(L1,NoCases); begin
SetLength(W,NoSelected); Messagedlg('No valid number of groups given.', mtError, [mbOK], 0);
SetLength(XAxis,NoCases); exit;
SetLength(YAxis,NoCases); end;
SetLength(means,NoSelected); end;
SetLength(variances,NoSelected);
SetLength(stddevs,NoSelected); MaxError := 0.0;
SetLength(Distance,NoCases,NoCases); GrpCnt := 0;
SetLength(varlabels,NoSelected); NoSelected := PredList.Items.Count;
SetLength(rowlabels,NoCases); if not VarChk.Checked then
SetLength(ColSelected,NoSelected); begin
Ncols := NoSelected; SetLength(w2,NoCases);
Nrows := NoCases; SetLength(k4,NoCases);
for i := 0 to Ncols - 1 do SetLength(k5,NoCases);
begin SetLength(L1,NoCases);
cellstring := PredList.Items.Strings[i]; SetLength(W,NoSelected);
for j := 1 to NoVariables do SetLength(XAxis,NoCases);
begin SetLength(YAxis,NoCases);
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then SetLength(means,NoSelected);
begin SetLength(variances,NoSelected);
varlabels[i] := cellstring; SetLength(stddevs,NoSelected);
ColSelected[i] := j; SetLength(Distance,NoCases,NoCases);
end; SetLength(varlabels,NoSelected);
end; SetLength(rowlabels,NoCases);
end; SetLength(ColSelected,NoSelected);
for i := 0 to NoCases-1 do rowlabels[i] := IntToStr(i); Ncols := NoSelected;
end Nrows := NoCases;
else begin for i := 0 to Ncols - 1 do
SetLength(w2,NoSelected); begin
SetLength(k4,NoSelected); cellstring := PredList.Items.Strings[i];
SetLength(k5,NoSelected); for j := 1 to NoVariables do
SetLength(L1,NoSelected); begin
SetLength(W,NoCases); if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
SetLength(XAxis,NoSelected); begin
SetLength(YAxis,NoSelected); varlabels[i] := cellstring;
SetLength(means,NoCases); ColSelected[i] := j;
SetLength(variances,NoCases); end;
SetLength(stddevs,NoCases); end;
SetLength(Distance,NoSelected,NoCases); end;
SetLength(varlabels,NoCases); for i := 0 to NoCases-1 do rowlabels[i] := IntToStr(i);
SetLength(rowlabels,NoSelected); end else
SetLength(ColSelected,NoSelected); begin
Ncols := NoCases; SetLength(w2,NoSelected);
Nrows := NoSelected; SetLength(k4,NoSelected);
//Get labels of selected variables SetLength(k5,NoSelected);
for i := 0 to Nrows - 1 do SetLength(L1,NoSelected);
begin SetLength(W,NoCases);
cellstring := PredList.Items.Strings[i]; SetLength(XAxis,NoSelected);
for j := 1 to NoVariables do SetLength(YAxis,NoSelected);
begin SetLength(means,NoCases);
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then SetLength(variances,NoCases);
begin SetLength(stddevs,NoCases);
ColSelected[i] := j; SetLength(Distance,NoSelected,NoCases);
rowlabels[i] := cellstring; SetLength(varlabels,NoCases);
end; SetLength(rowlabels,NoSelected);
end; SetLength(ColSelected,NoSelected);
end; Ncols := NoCases;
for i := 0 to NoCases-1 do varlabels[i] := IntToStr(i); Nrows := NoSelected;
end; //Get labels of selected variables
if MembersChk.Checked then k3 := 1 else k3 := 0; 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 for j := 0 to Ncols-1 do
begin begin
@@ -199,45 +218,45 @@ begin
if VarChk.Checked = false then if VarChk.Checked = false then
begin begin
// Get labels of rows // Get labels of rows
// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i]; // for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i];
// Get data into the distance matrix // Get data into the distance matrix
count := 0; count := 0;
for i := 1 to Nrows do for i := 1 to Nrows do
begin begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue; if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1; count := count + 1;
for j := 1 to Ncols do for j := 1 to Ncols do
begin begin
col := ColSelected[j-1]; col := ColSelected[j-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]));
means[j-1] := means[j-1] + X; means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X); variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X; Distance[i-1,j-1] := X;
end; end;
end; end;
end end else
else begin // cluster variables begin // cluster variables
// Get labels of columns // Get labels of columns
// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[i,0]; // for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[i,0];
// Get data into the distance matrix // Get data into the distance matrix
count := 0; count := 0;
for i := 1 to Nrows do // actually grid column in this case for i := 1 to Nrows do // actually grid column in this case
begin begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; // if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1; count := count + 1;
for j := 1 to Ncols do // actually grid rows in this case for j := 1 to Ncols do // actually grid rows in this case
begin begin
// if (not GoodRecord(j,NoSelected,ColSelected)) then continue; // if (not GoodRecord(j,NoSelected,ColSelected)) then continue;
col := ColSelected[i-1]; col := ColSelected[i-1];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j])); X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j]));
means[j-1] := means[j-1] + X; means[j-1] := means[j-1] + X;
variances[j-1] := variances[j-1] + (X * X); variances[j-1] := variances[j-1] + (X * X);
Distance[i-1,j-1] := X; Distance[i-1,j-1] := X;
end; end;
end; end;
end; end;
// Calculate means and standard deviations of variables // Calculate means and standard deviations of variables
@@ -250,266 +269,263 @@ begin
end; end;
// Ready the output form // Ready the output form
OutputFrm.RichEdit.Clear; lReport := TStringList.Create;
OutputFrm.RichEdit.Lines.Add('Hierarchical Cluster Analysis'); try
OutputFrm.RichEdit.Lines.Add(''); lReport.Add('HIERARCHICAL CLUSTER ANALYSIS');
outline := format('Number of objects to cluster := %d on %d variables.', lReport.Add('');
[Nrows, Ncols]); lReport.Add('Number of objects to cluster: %d on %d variables.', [Nrows, Ncols]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('');
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;
// Standardize the distance scores if elected if StatsChk.Checked then
if (StdChk.Checked) then begin
begin DynVectorPrint(means, Ncols, 'Variable Means', varlabels, count, lReport);
for j := 0 to Ncols-1 do DynVectorPrint(variances, Ncols, 'Variable Variances', varlabels, count, lReport);
for i := 0 to Nrows-1 do DynVectorPrint(stddevs, Ncols, 'Variable Standard Deviations', varlabels, count, lReport);
Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j]; lReport.Add(DIVIDER);
end; lReport.Add('');
end;
if (ReplaceChk.Checked) then // replace original values in grid with z scores if elected // Standardize the distance scores if elected
begin 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 for i := 1 to Nrows do
begin begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue; if not GoodRecord(i,NoSelected,ColSelected) then continue;
for j := 1 to Ncols do for j := 1 to Ncols do
begin begin
col := ColSelected[j-1]; col := ColSelected[j-1];
outline := format('%6.4f',[Distance[i-1,j-1]]); OS3MainFrm.DataGrid.Cells[col,i] := Format('%6.4f', [Distance[i-1,j-1]]);
OS3MainFrm.DataGrid.Cells[col,i] := outline;
end; end;
end; end;
end; end;
// Convert data matrix to initial matrix of error potentials // Convert data matrix to initial matrix of error potentials
for i := 1 to Nrows do for i := 1 to Nrows do
begin begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; // if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
for j := 1 to Ncols do W[j-1] := Distance[i-1,j-1]; for j := 1 to Ncols do
for j := i to Nrows do W[j-1] := Distance[i-1,j-1];
begin for j := i to Nrows do
begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; // if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
Distance[i-1,j-1] := 0.0; Distance[i-1,j-1] := 0.0;
for k := 1 to Ncols do Distance[i-1,j-1] := Distance[i-1,j-1] + for k := 1 to Ncols do
(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] + (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; 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;
end; end;
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 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 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 begin
L := 0; if (k5[i-1] = i) then
for j := 1 to Nrows do
begin begin
if (k5[j-1] = i) then for j := i to Nrows do
begin begin
L := L + 1; if ((i <> j) and (k5[j-1] = j)) then
L1[L-1] := k4[j-1]; begin
if k3 = 1 then L1[L-1] := j; 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;
end; end;
if k3 = 1 then end;
begin w2[L-1] := w3;
outline := format('Group %d (n := %d)',[i,L]); if (n3 > k1) then goto next1;
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;
if (PlotChk.Checked) then // print group memberships of all objects, if optioned
begin for i := 1 to Nrows do
SetLength(GraphFrm.Ypoints,1,GrpCnt); begin
SetLength(GraphFrm.Xpoints,1,GrpCnt); if (k5[i-1] = i) then
for i := 1 to GrpCnt do begin
begin L := 0;
GraphFrm.Ypoints[0,i-1] := YAxis[i-1]; for j := 1 to Nrows do
GraphFrm.Xpoints[0,i-1] := XAxis[i-1]; begin
end; if (k5[j-1] = i) then
GraphFrm.nosets := 1; begin
GraphFrm.nbars := GrpCnt; L := L + 1;
GraphFrm.Heading := 'NO. GROUPS VERSUS GROUPING ERROR'; L1[L-1] := k4[j-1];
GraphFrm.XTitle := 'NO. GROUPS'; if k3 = 1 then L1[L-1] := j;
GraphFrm.YTitle := 'ERROR'; 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.Ypoints[1] := YAxis;
// GraphFrm.Xpoints[1] := XAxis; // GraphFrm.Xpoints[1] := XAxis;
GraphFrm.AutoScaled := true; GraphFrm.AutoScaled := true;
GraphFrm.PtLabels := false; GraphFrm.PtLabels := false;
GraphFrm.GraphType := 7; // 2d points GraphFrm.GraphType := 7; // 2d points
GraphFrm.BackColor := clYellow; GraphFrm.BackColor := clCream;
GraphFrm.ShowBackWall := true; GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal; GraphFrm.ShowModal;
end; end;
// clean up finally
ColSelected := nil; lReport.Free;
rowlabels := nil; ColSelected := nil;
varlabels := nil; rowlabels := nil;
Distance := nil; varlabels := nil;
stddevs := nil; Distance := nil;
variances := nil; stddevs := nil;
means := nil; variances := nil;
YAxis := nil; means := nil;
XAxis := nil; YAxis := nil;
W := nil; XAxis := nil;
L1 := nil; W := nil;
k5 := nil; L1 := nil;
k4 := nil; k5 := nil;
w2 := nil; k4 := nil;
GraphFrm.Xpoints := nil; w2 := nil;
GraphFrm.Ypoints := nil; GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
end;
end; end;
procedure THierarchFrm.PredInClick(Sender: TObject); procedure THierarchFrm.PredInClick(Sender: TObject);
VAR i, index : integer; var
i: integer;
begin begin
index := VarList.Items.Count; i := 0;
i := 0; while i < VarList.Items.Count do
while i < index do begin
begin if VarList.Selected[i] then
if (VarList.Selected[i]) then begin
begin PredList.Items.Add(VarList.Items[i]);
PredList.Items.Add(VarList.Items.Strings[i]); VarList.Items.Delete(i);
VarList.Items.Delete(i); i := 0;
index := index - 1; end else
i := 0; i := i + 1;
end end;
else i := i + 1; UpdateBtnStates;
end;
PredOut.Enabled := true;
end; end;
procedure THierarchFrm.PredOutClick(Sender: TObject); procedure THierarchFrm.PredOutClick(Sender: TObject);
VAR index : integer; var
i: integer;
begin begin
index := PredList.ItemIndex; i := 0;
if index < 0 then while i < PredList.Items.Count do
begin begin
PredOut.Enabled := false; if PredList.Selected[i] then
exit; begin
end; VarList.Items.Add(PredList.Items[i]);
VarList.Items.Add(PredList.Items.Strings[index]); PredList.Items.Delete(i);
PredList.Items.Delete(index); 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; end;
initialization initialization

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

@@ -325,12 +325,12 @@ end;
procedure TPathFrm.ComputeBtnClick(Sender: TObject); procedure TPathFrm.ComputeBtnClick(Sender: TObject);
var var
i, j, k, col, row, NoVars, nocaused, NoSelected, NoIndepVars : integer; i, j, k, col, row, NoVars, nocaused, NoSelected, NoIndepVars : integer;
count, IER, noexogenous, t, L: integer; count, IER, noexogenous, L: integer;
constant, StdErrEst, ProbOut, R2, Temp, d2, sum, absdiff : double; constant, StdErrEst, ProbOut, R2, d2, sum, absdiff : double;
cellstring: string; cellstring: string;
ColNoSelected, selected : IntDyneVec; ColNoSelected, selected : IntDyneVec;
IndepIndex : IntDyneVec; IndepIndex : IntDyneVec;
rmat, WorkMat, PathCoef, IndMatrix, InvMatrix, e, W : DblDyneMat; rmat, WorkMat, PathCoef, IndMatrix, e, W : DblDyneMat;
means, variances, stddevs, beta, p : DblDyneVec; means, variances, stddevs, beta, p : DblDyneVec;
zvals : DblDyneMat; // z scores for path model zvals : DblDyneMat; // z scores for path model
genedz : IntDyneVec; // list of z's created for path models genedz : IntDyneVec; // list of z's created for path models
@@ -386,7 +386,6 @@ begin
SetLength(WorkMat,NoVariables+1,NoVariables+1); SetLength(WorkMat,NoVariables+1,NoVariables+1);
SetLength(PathCoef,NoVariables,NoVariables); SetLength(PathCoef,NoVariables,NoVariables);
SetLength(IndMatrix,NoVariables,NoVariables); SetLength(IndMatrix,NoVariables,NoVariables);
SetLength(InvMatrix,NoVariables,NoVariables);
SetLength(e,NoVariables,NoVariables); SetLength(e,NoVariables,NoVariables);
SetLength(W,NoVariables,NoVariables); SetLength(W,NoVariables,NoVariables);
SetLength(means,NoVariables); SetLength(means,NoVariables);
@@ -830,7 +829,6 @@ begin
means := nil; means := nil;
W := nil; W := nil;
e := nil; e := nil;
InvMatrix := nil;
IndMatrix := nil; IndMatrix := nil;
PathCoef := nil; PathCoef := nil;
WorkMat := 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; Size1, Size2, TotalSize, NoDeaths, ThisTime: integer;
mintime, maxtime, tempint, nopoints, tempvalue : integer; mintime, maxtime, tempint, nopoints, tempvalue : integer;
NoCensored, nocats, i, j, k, icase, oldtime, pos, first, last : 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; GroupCol : integer;
cumprop, proportion, term1, term2, term3 : double; cumprop, proportion, term1, term2, term3 : double;
E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double; E1, E2, O1, O2, Chisquare, ProbChi, Risk, LogRisk, SELogRisk : double;
@@ -227,7 +227,6 @@ begin
DeathsLabel := EventEdit.Text; DeathsLabel := EventEdit.Text;
TimeCol := 0; TimeCol := 0;
DeathsCol := 0; DeathsCol := 0;
CensoredCol := 0;
GroupCol := 0; GroupCol := 0;
for i := 1 to NoVariables do for i := 1 to NoVariables do
begin 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; Function GoodRecord(Row, NoVars: integer; const GridPos: IntDyneVec): boolean;
var var
i, j: integer; i, j: integer;
isgood: boolean;
begin begin
Result := true; Result := true;
for i := 1 to NoVars do for i := 1 to NoVars do