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

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

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

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

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

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

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

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