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

LazStats: Refactor LogLinScreenUnit. Calculation crashing. Some cleanup in DataProcs units.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7411 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-27 15:30:03 +00:00
parent b873677972
commit 82eea5cf08
7 changed files with 793 additions and 333 deletions
Download Patch File Download Diff File Expand all files Collapse all files

427
applications/lazstats/data/KSTest.laz Normal file
View File

@ -0,0 +1,427 @@
100
3
Freq
VARIABLE 1
2
I
0
99999
L
Value
VARIABLE 2
5
F
3
99999
L
Group
VARIABLE 3
1
I
0
99999
L
Case 0
Freq
Value
Group
Case 1
90
1.00
1
Case 2
111
2.00
1
Case 3
86
3.00
1
Case 4
108
4.00
1
Case 5
138
5.00
1
Case 6
98
6.00
1
Case 7
104
7.00
1
Case 8
88
8.00
1
Case 9
110
9.00
1
Case 10
91
10.00
1
Case 11
101
11.00
1
Case 12
116
12.00
1
Case 13
94
13.00
1
Case 14
98
14.00
1
Case 15
98
15.00
1
Case 16
91
16.00
1
Case 17
114
17.00
1
Case 18
72
18.00
1
Case 19
107
19.00
1
Case 20
98
20.00
1
Case 21
112
21.00
1
Case 22
96
22.00
1
Case 23
95
23.00
1
Case 24
84
24.00
1
Case 25
129
25.00
1
Case 26
111
26.00
1
Case 27
121
27.00
1
Case 28
111
28.00
1
Case 29
89
29.00
1
Case 30
91
30.00
1
Case 31
108
31.00
1
Case 32
96
32.00
1
Case 33
56
33.00
1
Case 34
112
34.00
1
Case 35
75
35.00
1
Case 36
99
36.00
1
Case 37
77
37.00
1
Case 38
121
38.00
1
Case 39
84
39.00
1
Case 40
87
40.00
1
Case 41
108
41.00
1
Case 42
102
42.00
1
Case 43
90
43.00
1
Case 44
81
44.00
1
Case 45
110
45.00
1
Case 46
91
46.00
1
Case 47
100
47.00
1
Case 48
107
48.00
1
Case 49
117
49.00
1
Case 50
99
50.00
1
Case 51
110
1.00
2
Case 52
97
2.00
2
Case 53
102
3.00
2
Case 54
116
4.00
2
Case 55
104
5.00
2
Case 56
80
6.00
2
Case 57
73
7.00
2
Case 58
109
8.00
2
Case 59
97
9.00
2
Case 60
90
10.00
2
Case 61
102
11.00
2
Case 62
98
12.00
2
Case 63
145
13.00
2
Case 64
104
14.00
2
Case 65
81
15.00
2
Case 66
108
16.00
2
Case 67
118
17.00
2
Case 68
92
18.00
2
Case 69
109
19.00
2
Case 70
139
20.00
2
Case 71
100
21.00
2
Case 72
93
22.00
2
Case 73
87
23.00
2
Case 74
88
24.00
2
Case 75
104
25.00
2
Case 76
84
26.00
2
Case 77
94
27.00
2
Case 78
84
28.00
2
Case 79
98
29.00
2
Case 80
92
30.00
2
Case 81
91
31.00
2
Case 82
90
32.00
2
Case 83
62
33.00
2
Case 84
101
34.00
2
Case 85
107
35.00
2
Case 86
106
36.00
2
Case 87
60
37.00
2
Case 88
86
38.00
2
Case 89
73
39.00
2
Case 90
100
40.00
2
Case 91
74
41.00
2
Case 92
128
42.00
2
Case 93
86
43.00
2
Case 94
61
44.00
2
Case 95
68
45.00
2
Case 96
99
46.00
2
Case 97
119
47.00
2
Case 98
90
48.00
2
Case 99
118
49.00
2
Case 100
80
50.00
2

67
applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.lfm
View File

@ -22,6 +22,7 @@ object LogLinScreenFrm: TLogLinScreenFrm
Width = 337
BorderSpacing.Left = 8
BorderSpacing.Top = 12
BorderSpacing.Right = 16
Caption = '1. Select the variables of the Grid that define your classifications'
ParentColor = False
end
@ -93,6 +94,7 @@ object LogLinScreenFrm: TLogLinScreenFrm
Constraints.MinHeight = 220
ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 3
end
object InBtn: TBitBtn
@ -157,6 +159,7 @@ object LogLinScreenFrm: TLogLinScreenFrm
BorderSpacing.Left = 8
BorderSpacing.Right = 8
ItemHeight = 0
OnSelectionChange = SelectListSelectionChange
TabOrder = 7
end
object Panel1: TPanel
@ -313,94 +316,75 @@ object LogLinScreenFrm: TLogLinScreenFrm
end
end
object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 101
Left = 193
Height = 25
Top = 551
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 = 10
end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 167
Height = 25
Top = 551
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
OnClick = CancelBtnClick
TabOrder = 11
end
object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 241
Left = 255
Height = 25
Top = 551
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 = 12
TabOrder = 11
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 329
Left = 339
Height = 25
Top = 551
Width = 61
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Return'
ModalResult = 1
OnClick = ReturnBtnClick
TabOrder = 13
Caption = 'Close'
ModalResult = 11
OnClick = CloseBtnClick
TabOrder = 12
end
object HelpBtn: TButton
Tag = 131
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 38
Left = 134
Height = 25
Top = 551
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
@ -410,7 +394,7 @@ object LogLinScreenFrm: TLogLinScreenFrm
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 535
@ -431,6 +415,7 @@ object LogLinScreenFrm: TLogLinScreenFrm
ParentColor = False
end
object Label11: TLabel
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label10
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner

243
applications/lazstats/source/forms/analysis/cross-classification/loglinscreenunit.pas
View File

@ -1,3 +1,13 @@
// File for testing: ABCLogLinData.laz
// Use all variables in original order
// Click the button and define Min/max values:
// variable "Row": 1 .. 2
// variable "Col": 1 .. 2
// variable "Slice": 1 .. 3
// variable "X": 1 .. 9
//
// NOTE: the calculation crashes
unit LogLinScreenUnit;
{$mode objfpc}{$H+}
@ -22,9 +32,8 @@ type
OutBtn: TBitBtn;
AllBtn: TBitBtn;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
MarginsChk: TCheckBox;
GenlModelChk: TCheckBox;
GroupBox1: TGroupBox;
@ -44,7 +53,6 @@ type
CountVarChk: TCheckBox;
Label1: TLabel;
procedure AllBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -55,8 +63,9 @@ type
procedure MinEditKeyPress(Sender: TObject; var Key: char);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure ReturnBtnClick(Sender: TObject);
procedure CloseBtnClick(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure SelectListSelectionChange(Sender: TObject; User: boolean);
procedure Step2BtnClick(Sender: TObject);
function ArrayPosition(Sender: TObject; NoDims : integer;
VAR Data : DblDyneVec;
@ -68,10 +77,12 @@ type
VAR Indexes : IntDyneMat;
VAR Data : DblDyneVec;
VAR Margins : IntDyneMat);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private
{ private declarations }
FAutoSized: Boolean;
procedure UpdateBtnStates;
procedure Screen(VAR NVAR : integer;
VAR MP : integer; VAR MM : integer;
VAR NTAB : integer; VAR TABLE : DblDyneVec;
@ -130,7 +141,7 @@ var
implementation
uses
Math;
Math, Utils;
{ TLogLinScreenFrm }
@ -156,7 +167,7 @@ begin
for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TLogLinScreenFrm.ReturnBtnClick(Sender: TObject);
procedure TLogLinScreenFrm.CloseBtnClick(Sender: TObject);
begin
Maximums := nil;
Minimums := nil;
@ -170,6 +181,12 @@ begin
VarNoEdit.Text := IntToStr(ScrollBar1.Position);
end;
procedure TLogLinScreenFrm.SelectListSelectionChange(Sender: TObject;
User: boolean);
begin
UpdateBtnStates;
end;
procedure TLogLinScreenFrm.Step2BtnClick(Sender: TObject);
begin
if CountVarChk.Checked then
@ -186,16 +203,23 @@ begin
end;
procedure TLogLinScreenFrm.InBtnClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := VarList.ItemIndex;
SelectList.Items.Add(VarList.Items.Strings[index]);
VarList.Items.Delete(index);
OutBtn.Enabled := true;
i := 0;
while i < VarList.Items.Count do
begin
if VarList.Selected[i] then
begin
SelectList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
NoDims := NoDims + 1;
ScrollBar1.Max := NoDims;
index := VarList.Items.Count;
if index <= 0 then InBtn.Enabled := false;
i := 0;
end else
i := i + 1;
end;
Scrollbar1.Max := NoDims;
UpdateBtnStates;
end;
procedure TLogLinScreenFrm.MaxEditKeyPress(Sender: TObject; var Key: char);
@ -227,12 +251,11 @@ begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
@ -243,7 +266,6 @@ end;
procedure TLogLinScreenFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm);
end;
procedure TLogLinScreenFrm.FormShow(Sender: TObject);
@ -258,25 +280,16 @@ begin
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TLogLinScreenFrm.CancelBtnClick(Sender: TObject);
begin
Maximums := nil;
Minimums := nil;
Response := nil;
Interact := nil;
Close;
end;
procedure TLogLinScreenFrm.AllBtnClick(Sender: TObject);
VAR i, count : integer;
var
i: integer;
begin
count := VarList.Items.Count;
for i := 0 to count-1 do
SelectList.Items.Add(VarList.Items.Strings[i]);
InBtn.Enabled := false;
OutBtn.Enabled := true;
for i := 0 to VarList.Items.Count-1 do
SelectList.Items.Add(VarList.Items[i]);
VarList.Clear;
NoDims := SelectList.Items.Count;
ScrollBar1.Max := NoDims;
UpdateBtnStates;
end;
procedure TLogLinScreenFrm.ComputeBtnClick(Sender: TObject);
@ -320,9 +333,10 @@ var
IFAULT : integer;
TABLE : DblDyneVec;
DIM : IntDyneVec;
lReport: TStrings;
begin
OutputFrm.RichEdit.Clear;
lReport := TStringList.Create;
try
// Allocate space for labels, DimSize and SubScripts
NoVars := SelectList.Items.Count;
SetLength(Labels,NoVars);
@ -407,21 +421,21 @@ begin
// Print Marginal totals if requested
if MarginsChk.Checked then
begin
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text);
lReport.Add('');
for i := 1 to NoDims do
begin
HeadStr := 'Marginal Totals for ' + Labels[i-1];
k := DimSize[i-1];
for j := 0 to k-1 do WorkVec[j] := Margins[i-1,j];
VecPrint(WorkVec,k,HeadStr);
VecPrint(WorkVec,k,HeadStr, lReport);
end;
end;
OutputFrm.RichEdit.Lines.Add('');
astr := Format('Total Frequencies = %d',[N]);
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.ShowModal;
lReport.Add('');
lReport.Add('Total Frequencies: %d', [N]);
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
// Get Expected cell values
U := 0.0; // overall mean (mu) of log linear model
@ -440,18 +454,23 @@ begin
U := U / ArraySize;
// print expected values
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text);
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('EXPECTED CELL VALUES FOR MODEL OF COMPLETE INDEPENDENCE');
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Cell Observed Expected Log Expected');
lReport.Add('FILE: '+ OS3MainFrm.FileNameEdit.Text);
lReport.Add('');
lReport.Add('EXPECTED CELL VALUES FOR MODEL OF COMPLETE INDEPENDENCE');
lReport.Add('');
astr := 'Cell';
for j := 2 to NoDims do astr := astr + ' ';
lReport.Add(astr + 'Observed Expected Log Expected');
astr := '';
for j := 1 to NoDims do astr := astr + '--- ';
astr := astr + '---------- ---------- ----------';
lReport.Add(astr);
for i := 1 to ArraySize do
begin
astr := '';
for j := 1 to NoDims do astr := astr + format('%3d ',[Indexes[i-1,j-1]]);
astr := astr + format('%10.0f %10.2f %10.3f',[Data[i-1],Expected[i-1],LogM[i-1]]);
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add(astr);
end;
chi2 := 0.0;
G2 := 0.0;
@ -467,24 +486,22 @@ begin
for i := 1 to NoDims do DF := DF * (DimSize[i-1]-1);
ProbChi2 := 1.0 - Chisquaredprob(chi2,DF);
ProbG2 := 1.0 - Chisquaredprob(G2,DF);
astr := format('Chisquare = %10.3f with probability = %10.3f (DF = %d)',[chi2,ProbChi2,DF]);
OutputFrm.RichEdit.Lines.Add(astr);
astr := format('G squared = %10.3f with probability = %10.3f (DF = %d)',[G2,ProbG2,DF]);
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.RichEdit.Lines.Add('');
astr := format('U (mu) for general loglinear model = %10.2f',[U]);
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.ShowModal;
lReport.Add('Chisquare: %10.3f with probability %10.3f (DF = %d)',[chi2, ProbChi2, DF]);
lReport.Add('G squared: %10.3f with probability %10.3f (DF = %d)',[G2, ProbG2, DF]);
lReport.Add('');
lReport.Add('U (mu) for general loglinear model: %10.2f', [U]);
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
// Get log linear model values for each cell
// get M's for each cell
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('First Order LogLinear Model Factors and N of Cells in Each');
lReport.Add('First Order LogLinear Model Factors and N of Cells in Each');
astr := 'CELL ';
for i := 1 to NoDims do astr := astr + format(' U%d N Cells ',[i]);
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add(astr);
lReport.Add('');
for i := 1 to ArraySize do // cell
begin
astr := '';
@ -506,20 +523,20 @@ begin
Mu := Mu / count - U;
astr := astr + format('%10.3f %3d ',[Mu,count]);
end;
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add(astr);
end;
OutputFrm.ShowModal;
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
// get second order interactions
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Lines.Add('');
OutputFrm.RichEdit.Lines.Add('Second Order Loglinear Model Terms and N of Cells in Each');
lReport.Add('Second Order Loglinear Model Terms and N of Cells in Each');
astr := 'CELL ';
for i := 1 to NoDims-1 do
for j := i + 1 to NoDims do
astr := astr + format('U%d%d N Cells ',[i,j]);
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.RichEdit.Lines.Add('');
lReport.Add(astr);
lReport.Add('');
for i := 1 to ArraySize do // cell
begin
astr := '';
@ -542,14 +559,15 @@ begin
end;
end; // next l
Mu := Mu / count - U;
astr := astr + format('%10.3f %3d',[Mu,count]);
astr := astr + Format('%10.3f %3d', [Mu, count]);
end; // next k (second term subscript)
end; // next j (first term subscript)
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add(astr);
end; // next i
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add('');
// get maximum no. of interactions in saturated model
MaxCombos(NoDims, MM, MP);
@ -581,43 +599,37 @@ begin
COORD,X,Y,IFAULT);
// show results
astr := 'SCREEN FOR INTERACTIONS AMONG THE VARIABLES';
OutputFrm.RichEdit.Lines.Add(astr);
astr := 'Adapted from the Fortran program by Lustbader and Stodola printed in';
OutputFrm.RichEdit.Lines.Add(astr);
astr := 'Applied Statistics, Volume 30, Issue 1, 1981, pages 97-105 as Algorithm';
OutputFrm.RichEdit.Lines.Add(astr);
astr := 'AS 160 Partial and Marginal Association in Multidimensional Contingency Tables';
OutputFrm.RichEdit.Lines.Add(astr);
OutputFrm.RichEdit.Lines.Add('');
astr := 'Statistics for tests that the interactions of a given order are zero';
OutputFrm.RichEdit.Lines.Add(astr);
astr := 'ORDER STATISTIC D.F. PROB.';
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add('SCREEN FOR INTERACTIONS AMONG THE VARIABLES');
lReport.Add('Adapted from the Fortran program by Lustbader and Stodola printed in');
lReport.Add('Applied Statistics, Volume 30, Issue 1, 1981, pages 97-105 as Algorithm');
lReport.Add('AS 160 Partial and Marginal Association in Multidimensional Contingency Tables');
lReport.Add('');
lReport.Add('Statistics for tests that the interactions of a given order are zero');
lReport.Add('ORDER STATISTIC D.F. PROB.');
lReport.Add('----- ---------- ---- ----------');
for i := 1 to NoDims do
begin
ProbChi2 := 1.0 - ChiSquaredProb(GSQ[i],DGFR[i]);
astr := format('%5d %10.3f %3d %10.3f',[i,GSQ[i],DGFR[i],ProbChi2]);
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add('%5d %10.3f %4d %10.3f',[i,GSQ[i],DGFR[i],ProbChi2]);
end;
OutputFrm.RichEdit.Lines.Add('');
astr := 'Statistics for Marginal Association Tests';
OutputFrm.RichEdit.Lines.Add(astr);
astr := 'VARIABLE ASSOC. PART ASSOC. MARGINAL ASSOC. D.F. PROB';
OutputFrm.RichEdit.Lines.Add(astr);
lReport.Add('');
lReport.Add('Statistics for Marginal Association Tests');
lReport.Add('VARIABLE ASSOC. PART ASSOC. MARGINAL ASSOC. D.F. PROB');
lReport.Add('-------- ------ ----------- --------------- ---- ----------');
for i := 1 to NoDims-1 do
begin
for j := 1 to MP do
begin
ProbChi2 := 1.0 - ChiSquaredProb(MARG[i,j],DFS[i,j]);
astr := format('%5d %5d %10.3f %10.3f %3d %10.3f',
lReport.Add('%6d %5d %10.3f %12.3f %3d %10.3f',
[i,j,Part[i,j],MARG[i,j], DFS[i,j],ProbChi2]);
OutputFrm.RichEdit.Lines.Add(astr);
end;
end;
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
DisplayReport(lReport);
finally
lReport.Free;
TABLE := nil;
DIM := nil;
Y := nil;
@ -647,20 +659,27 @@ begin
Subscripts := nil;
DimSize := nil;
Labels := nil;
end;
end;
procedure TLogLinScreenFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := SelectList.ItemIndex;
if index < 0 then exit;
VarList.Items.Add(SelectList.Items.Strings[index]);
SelectList.Items.Delete(index);
index := SelectList.Items.Count;
if index <= 0 then OutBtn.Enabled := false;
InBtn.Enabled := true;
i := 0;
while i < SelectList.Items.Count do
begin
if SelectList.Selected[i] then
begin
VarList.Items.Add(SelectList.Items[i]);
SelectList.Items.Delete(i);
i := 0;
NoDims := NoDims - 1;
end else
i := i + 1;
end;
if NoDims > 0 then ScrollBar1.Max := NoDims else ScrollBar1.Max := 1;
UpdateBtnStates;
end;
procedure TLogLinScreenFrm.Screen(var NVAR: integer; var MP: integer;
@ -1165,6 +1184,18 @@ begin
end;
end;
procedure TLogLinScreenFrm.UpdateBtnStates;
begin
InBtn.Enabled := AnySelected(VarList);
OutBtn.Enabled := AnySelected(SelectList);
AllBtn.Enabled := VarList.Items.Count > 0;
end;
procedure TLogLinScreenFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
initialization
{$I loglinscreenunit.lrs}

12
applications/lazstats/source/forms/mainunit.lfm
View File

@ -411,17 +411,17 @@ object OS3MainFrm: TOS3MainFrm
Caption = 'Insert New Row'
OnClick = NewRowClick
end
object CopyRow: TMenuItem
object CopyRowMenu: TMenuItem
Caption = 'Copy Row'
OnClick = CopyRowClick
OnClick = CopyRowMenuClick
end
object CutRow: TMenuItem
object CutRowMenu: TMenuItem
Caption = 'Cut Row'
OnClick = CutRowClick
OnClick = CutRowMenuClick
end
object PasteRow: TMenuItem
object PasteRowMenu: TMenuItem
Caption = 'Paste Row'
OnClick = PasteRowClick
OnClick = PasteRowMenuClick
end
end
object MenuItem5: TMenuItem

50
applications/lazstats/source/forms/mainunit.pas
View File

@ -134,9 +134,9 @@ type
CutCol: TMenuItem;
PasteCol: TMenuItem;
NewRow: TMenuItem;
CopyRow: TMenuItem;
CutRow: TMenuItem;
PasteRow: TMenuItem;
CopyRowMenu: TMenuItem;
CutRowMenu: TMenuItem;
PasteRowMenu: TMenuItem;
MenuItem71: TMenuItem;
MenuItem72: TMenuItem;
MenuItem73: TMenuItem;
@ -264,14 +264,14 @@ type
procedure CloseFileBtnClick(Sender: TObject);
procedure CompareDistsClick(Sender: TObject);
procedure CopyColClick(Sender: TObject);
procedure CopyRowClick(Sender: TObject);
procedure CopyRowMenuClick(Sender: TObject);
procedure CorrDiffClick(Sender: TObject);
procedure CorrespondenceClick(Sender: TObject);
procedure CrossTabsClick(Sender: TObject);
procedure CSVFileInClick(Sender: TObject);
procedure CSVFileOutClick(Sender: TObject);
procedure CutColClick(Sender: TObject);
procedure CutRowClick(Sender: TObject);
procedure CutRowMenuClick(Sender: TObject);
procedure DataGridClick(Sender: TObject);
procedure DataGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
@ -381,7 +381,7 @@ type
procedure OpenFileBtnClick(Sender: TObject);
procedure OptionClick(Sender: TObject);
procedure PasteColClick(Sender: TObject);
procedure PasteRowClick(Sender: TObject);
procedure PasteRowMenuClick(Sender: TObject);
procedure pcontrochartClick(Sender: TObject);
// procedure PicViewClick(Sender: TObject);
procedure PlotXvsYClick(Sender: TObject);
@ -858,9 +858,9 @@ begin
PasteColumn;
end;
procedure TOS3MainFrm.PasteRowClick(Sender: TObject);
procedure TOS3MainFrm.PasteRowMenuClick(Sender: TObject);
begin
PasteARow;
PasteRow;
end;
// Menu "Analysis" > "Statistical Process Control" > "p Control Chart"
@ -888,13 +888,28 @@ begin
end;
procedure TOS3MainFrm.PrintDefsClick(Sender: TObject);
var
lReport: TStrings;
begin
PrintDict;
lReport := TStringList.Create;
try
PrintDict(lReport);
DisplayReport(lReport);
finally
lReport.Free;
end;
end;
procedure TOS3MainFrm.PrintGridClick(Sender: TObject);
var
lReport: TStrings;
begin
PrintData;
lReport := TStringList.Create;
try
PrintData(lReport);
finally
lReport.Free;
end;
end;
// Menu "Simulations" > "Probability > z"
@ -1489,9 +1504,9 @@ begin
CopyColumn;
end;
procedure TOS3MainFrm.CopyRowClick(Sender: TObject);
procedure TOS3MainFrm.CopyRowMenuClick(Sender: TObject);
begin
CopyaRow;
CopyRow;
end;
// Menu "Analysis" > "Comparisons" > "Difference Between Correlations"
@ -1528,18 +1543,15 @@ begin
DeleteCol;
end;
procedure TOS3MainFrm.CutRowClick(Sender: TObject);
procedure TOS3MainFrm.CutRowMenuClick(Sender: TObject);
begin
CutaRow;
CutRow;
end;
procedure TOS3MainFrm.DataGridClick(Sender: TObject);
VAR row, col : integer;
begin
row := DataGrid.Row;
col := DataGrid.Col;
RowEdit.Text := IntToStr(row);
ColEdit.Text := IntToStr(col);
RowEdit.Text := IntToStr(DataGrid.Row);
ColEdit.Text := IntToStr(DataGrid.Col);
end;
procedure TOS3MainFrm.FormShow(Sender: TObject);

2
applications/lazstats/source/forms/tools/selectcasesunit.pas
View File

@ -463,7 +463,7 @@ begin
if OS3MainFrm.DataGrid.Cells[filtcol,delrow] = 'NO' then
begin
OS3MainFrm.DataGrid.Row := delrow;
CutaRow;
CutRow;
end
else delrow := delrow + 1;
end;

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

@ -7,13 +7,13 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Clipbrd,
Globals, OptionsUnit, DictionaryUnit, OutputUnit;
Globals, OptionsUnit, DictionaryUnit;
Function GoodRecord(Row, NoVars: integer; const GridPos: IntDyneVec): boolean;
procedure FormatCell(Col, Row : integer);
procedure FormatGrid;
function IsNumeric(s : string) : boolean;
procedure VecPrint(vector : IntDyneVec; Size : integer; Heading : string);
procedure VecPrint(vector: IntDyneVec; Size: integer; Heading: string; AReport: TStrings);
procedure SaveOS2File;
procedure OpenOS2File;
procedure OpenOS2File(const AFileName: String; ShowDictionaryForm: Boolean);
@ -22,11 +22,11 @@ procedure CopyColumn;
procedure PasteColumn;
procedure InsertCol;
procedure InsertRow;
procedure CutaRow;
procedure CopyaRow;
procedure PasteaRow;
procedure PrintDict;
procedure PrintData;
procedure CutRow;
procedure CopyRow;
procedure PasteRow;
procedure PrintDict(AReport: TStrings);
procedure PrintData(AReport: TStrings);
procedure OpenTabFile;
procedure SaveTabFile;
function ValidValue(row, col : integer) : boolean;
@ -193,43 +193,44 @@ begin
end;
//-----------------------------------------------------------------------------
procedure VecPrint(vector : IntDyneVec; Size : integer; Heading : string);
procedure VecPrint(vector: IntDyneVec; Size: integer; Heading: string; AReport: TStrings);
var
i, start, last : integer;
nvals : integer;
done : boolean;
astr : string;
i, start, last: integer;
nvals: integer;
done: boolean;
astr: string;
begin
nvals := 8;
done := false;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add(Heading);
OutPutFrm.RichEdit.Lines.Add('');
AReport.Add('');
AReport.Add(Heading);
Areport.Add('');
start := 1;
last := nvals;
if last > Size then last := Size;
while not done do
begin
astr := '';
for i := start to last do
astr := astr + format('%8d ',[i]);
OutPutFrm.RichEdit.Lines.Add(astr);
astr := astr + Format('%8d ',[i]);
AReport.Add(astr);
astr := '';
for i := start to last do
astr := astr + format('%8d ',[vector[i-1]]);
OutPutFrm.RichEdit.Lines.Add(astr);
astr := astr + Format('%8d ',[vector[i-1]]);
AReport.Add(astr);
if last < Size then
begin
OutPutFrm.RichEdit.Lines.Add('');
AReport.Add('');
start := last + 1;
last := start + nvals - 1;
if last > Size then last := Size;
end
else done := true;
end else
done := true;
end;
end;
//-------------------------------------------------------------------
procedure SaveOS2File;
var
F: TextFile;
@ -462,11 +463,11 @@ end;
procedure PasteColumn;
var
col, i, j : integer;
buf : pchar;
size : integer;
strarray : array[0..100000] of char; // wp: Wow! What's this?
col, i, j: integer;
//buf: pchar;
//size: integer;
s: String;
//strarray : array[0..100000] of char; // wp: Wow! What's this?
begin
col := OS3MainFrm.DataGrid.Col;
NoVariables := OS3MainFrm.DataGrid.ColCount-1;
@ -483,45 +484,50 @@ begin
// NoVariables := NoVariables + 1;
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables);
end;
s := Clipboard.AsText;
OS3MainFrm.DataGrid.Cols[col].Text := s;
{
buf := strarray; // wp: Is this needed?
size := 100000;
ClipBoard.GetTextBuf(buf,size);
OS3MainFrm.DataGrid.Cols[col].SetText(buf);
}
end;
//-------------------------------------------------------------------
procedure CutaRow;
procedure CutRow;
var
row, i, j : integer;
buf : pchar;
row, i, j: integer;
buf: pchar;
begin
row := OS3MainFrm.DataGrid.Row;
buf := OS3MainFrm.DataGrid.Rows[row].GetText;
ClipBoard.SetTextBuf(buf);
// TempStream.Clear;
// OS3MainFrm.DataGrid.Rows[row].SaveToStream(TempStream);
for i := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[i,row] := '';
for i := 1 to NoVariables do
OS3MainFrm.DataGrid.Cells[i,row] := '';
if row < NoCases then
begin // move rows below up 1
for i := row + 1 to NoCases do
for j := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[j,i-1] := OS3MainFrm.DataGrid.Cells[j,i];
for j := 1 to NoVariables do OS3MainFrm.DataGrid.Cells[j,NoCases] := '';
end;
OS3MainFrm.DataGrid.RowCount := OS3MainFrm.DataGrid.RowCount - 1;
OS3MainFrm.RowEdit.Text := IntToStr(OS3MainFrm.DataGrid.RowCount-1);
NoCases := NoCases - 1;
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases);
// renumber cases
for i := 1 to NoCases do OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i);
end;
//-------------------------------------------------------------------
procedure CopyaRow;
procedure CopyRow;
var
row : integer;
buf : pchar;
row: integer;
buf: pchar;
begin
row := OS3MainFrm.DataGrid.Row;
buf := OS3MainFrm.DataGrid.Rows[row].GetText;
@ -531,12 +537,13 @@ begin
end;
//-------------------------------------------------------------------
procedure PasteaRow;
procedure PasteRow;
var
row, i, j : integer;
buf : pchar;
strarray : array[0..100000] of char; // wp: Like above
size : integer;
row, i, j: integer;
{
buf: pchar;
strarray: array[0..100000] of char; // wp: Like above
size: integer; }
begin
row := OS3MainFrm.DataGrid.Row;
@ -549,93 +556,91 @@ begin
OS3MainFrm.DataGrid.Cells[j,i+1] := OS3MainFrm.DataGrid.Cells[j,i];
end;
OS3MainFrm.DataGrid.Row := row;
OS3MainFrm.DataGrid.Rows[row].Text := Clipboard.AsText;
{
buf := strarray; // wp: is this needed?
size := 100000;
ClipBoard.GetTextBuf(buf,size);
OS3MainFrm.DataGrid.Rows[row].SetText(buf);
}
// Use the following instead of the previous 4 if clipboard is unavailable
// TempStream.Position := 0;
// OS3MainFrm.DataGrid.Rows[row].LoadFromStream(TempStream);
NoCases := NoCases + 1;
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoCases);
// renumber cases
for i := 1 to NoCases do OS3MainFrm.DataGrid.Cells[0,i] := 'CASE ' + IntToStr(i);
end;
//-------------------------------------------------------------------
procedure PrintDict;
procedure PrintDict(AReport: TStrings);
var
outline: string;
i : integer;
i: integer;
begin
OutputFrm.RichEdit.Clear;
OutputFrm.RichEdit.Alignment := taLeftJustify;
outline := OS3MainFrm.FileNameEdit.Text + ' VARIABLE DICTIONARY';
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
AReport.Add(OS3MainFrm.FileNameEdit.Text + ' VARIABLE DICTIONARY');
AReport.Add('');
for i:= 0 to NoVariables do
begin
outline := '';
outline := outline + '| ' + format('%9s',[DictionaryFrm.DictGrid.Cells[0,i]]);
outline := outline + ' | ' + format('%10s',[DictionaryFrm.DictGrid.Cells[1,i]]);
outline := outline + ' | ' + format('%15s',[DictionaryFrm.DictGrid.Cells[2,i]]);
outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[3,i]]);
outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[4,i]]);
outline := outline + ' | ' + format('%8s',[DictionaryFrm.DictGrid.Cells[5,i]]);
outline := outline + ' | ' + format('%7s',[DictionaryFrm.DictGrid.Cells[6,i]]);
outline := outline + ' | ' + format('%6s',[DictionaryFrm.DictGrid.Cells[7,i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := outline + '| ' + Format('%9s',[DictionaryFrm.DictGrid.Cells[0,i]]);
outline := outline + ' | ' + Format('%10s',[DictionaryFrm.DictGrid.Cells[1,i]]);
outline := outline + ' | ' + Format('%15s',[DictionaryFrm.DictGrid.Cells[2,i]]);
outline := outline + ' | ' + Format('%6s',[DictionaryFrm.DictGrid.Cells[3,i]]);
outline := outline + ' | ' + Format('%6s',[DictionaryFrm.DictGrid.Cells[4,i]]);
outline := outline + ' | ' + Format('%8s',[DictionaryFrm.DictGrid.Cells[5,i]]);
outline := outline + ' | ' + Format('%7s',[DictionaryFrm.DictGrid.Cells[6,i]]);
outline := outline + ' | ' + Format('%6s',[DictionaryFrm.DictGrid.Cells[7,i]]);
AReport.Add(outline);
end;
OutputFrm.ShowModal;
end;
//-------------------------------------------------------------------
procedure PrintData;
procedure PrintData(AReport: TStrings);
var
outline: string;
startcol: integer;
endcol: integer;
done: boolean;
cellstring: string;
i, j: integer;
begin
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Alignment := taLeftJustify;
outline := OS3MainFrm.FileNameEdit.Text;
OutPutFrm.RichEdit.Lines.Add(outline);
AReport.Add(OS3MainFrm.FileNameEdit.Text);
outline := IntToStr(NoCases);
outline := 'No. of Cases = ' + outline;
outline := outline + ', No. of Variables = ';
outline := outline + IntToStr(NoVariables);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
AReport.Add(outline);
AReport.Add('');
done := false;
startcol := 1;
while done = false do
while not done do
begin
endcol := startcol + 7;
if endcol > NoVariables then endcol := NoVariables;
for i:= 0 to NoCases do
begin
outline := '';
outline := format('%10s',[Trim(OS3MainFrm.DataGrid.Cells[0,i])]);
outline := Format('%10s',[Trim(OS3MainFrm.DataGrid.Cells[0,i])]);
for j := startcol to endcol do
begin
cellstring := format('%10s',[Trim(OS3MainFrm.DataGrid.Cells[j,i])]);
outline := outline + cellstring;
outline := outline + Format('%10s', [Trim(OS3MainFrm.DataGrid.Cells[j,i])]);
AReport.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
if endcol = NoVariables then done := true else
if endcol = NoVariables then
done := true
else
begin
startcol := endcol+1;
OutPutFrm.RichEdit.Lines.Add('');
AReport.Add('');
end;
end;
OutPutFrm.ShowModal;
end;
//-------------------------------------------------------------------
@ -1654,8 +1659,7 @@ begin
end;
function StringsToInt(strcol: integer; VAR newcol : integer; prompt : boolean) : boolean;
label endit;
VAR
var
i, j, k, NoStrings: integer;
TempString, response : string;
dup, savenewcol, strtype : boolean;
@ -1675,10 +1679,11 @@ begin
SetLength(OneString,NoCases+1);
// check to see if strcol is a string variable
if DictionaryFrm.DictGrid.Cells[4,strcol] = 'S' then strtype :=true
if DictionaryFrm.DictGrid.Cells[4,strcol] = 'S' then
strtype :=true
else begin
ShowMessage('ERROR! Column selected is not defined as a string variable');
goto endit;
MessageDlg('Column selected is not defined as a string variable', mtError, [mbOK], 0);
exit;
end;
// read the strings into the StrGrps array
@ -1753,11 +1758,11 @@ begin
end;
// clean up memory
endit: OneString := nil;
OneString := nil;
StrGrps := nil;
// return results
StringsToInt := savenewcol;
Result := savenewcol;
end;