LazStats: Inherit ExactUnit from TBasicStatsReportForm

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7820 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-27 21:51:59 +00:00
parent 0269c3f49c
commit e3a44f85d3
2 changed files with 697 additions and 685 deletions

View File

@ -1,28 +1,51 @@
object FisherFrm: TFisherFrm
inherited FisherFrm: TFisherFrm
Left = 535
Height = 472
Height = 524
Top = 234
Width = 672
Width = 691
HelpType = htKeyword
HelpKeyword = 'html/FishersExactTest.htm'
Caption = 'Fisher''s Exact Test for a 2 by 2 Table'
ClientHeight = 472
ClientWidth = 672
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
LCLVersion = '2.1.0.0'
object InputGrp: TRadioGroup
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 8
ClientHeight = 524
ClientWidth = 691
inherited ParamsPanel: TPanel
Height = 508
Width = 428
ClientHeight = 508
ClientWidth = 428
inherited CloseBtn: TButton
Left = 373
Top = 483
TabOrder = 5
end
inherited ComputeBtn: TButton
Left = 289
Top = 483
TabOrder = 4
end
inherited ResetBtn: TButton
Left = 227
Top = 483
TabOrder = 3
end
inherited HelpBtn: TButton
Left = 168
Top = 483
TabOrder = 2
end
inherited ButtonBevel: TBevel
Top = 467
Width = 428
end
object InputGrp: TRadioGroup[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
Left = 0
Height = 114
Top = 8
Top = 0
Width = 425
AutoFill = True
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Input Options'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
@ -44,80 +67,273 @@ object FisherFrm: TFisherFrm
OnClick = InputGrpClick
TabOrder = 0
end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 455
Height = 25
Top = 439
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 3
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 521
Height = 25
Top = 439
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 4
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 605
Height = 25
Top = 439
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 5
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 423
Width = 672
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Panel2: TPanel
AnchorSideLeft.Control = InputGrp
AnchorSideLeft.Side = asrBottom
object Notebook: TNotebook[6]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = InputGrp
Left = 449
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = AlphaEdit
Left = 0
Height = 322
Top = 114
Width = 428
PageIndex = 0
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 8
TabOrder = 1
object GridDataPage: TPage
object Label1: TLabel
AnchorSideLeft.Control = GridDataPage
AnchorSideTop.Control = GridDataPage
Left = 0
Height = 15
Top = 12
Width = 97
BorderSpacing.Top = 12
Caption = 'Available Variables'
ParentColor = False
end
object RowLabel: TLabel
AnchorSideLeft.Control = RowEdit
AnchorSideBottom.Control = RowEdit
Left = 233
Height = 15
Top = 33
Width = 67
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Row Variable'
ParentColor = False
end
object ColLabel: TLabel
AnchorSideLeft.Control = ColEdit
AnchorSideBottom.Control = ColEdit
Left = 233
Height = 15
Top = 113
Width = 87
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Column Variable'
ParentColor = False
end
object DepLabel: TLabel
AnchorSideLeft.Control = DepEdit
AnchorSideBottom.Control = DepEdit
Left = 233
Height = 15
Top = 193
Width = 99
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Variable to Analyze'
ParentColor = False
end
object NCasesLabel: TLabel
AnchorSideTop.Control = NCasesEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = NCasesEdit
Left = 263
Height = 15
Top = 257
Width = 97
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Total No. of Cases:'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = GridDataPage
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = RowIn
AnchorSideBottom.Control = GridDataPage
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 293
Top = 29
Width = 195
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Right = 6
ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0
end
object RowIn: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 201
Height = 26
Top = 29
Width = 26
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = RowInClick
Spacing = 0
TabOrder = 1
end
object RowEdit: TEdit
AnchorSideLeft.Control = RowIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GridDataPage
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RowOut
AnchorSideBottom.Side = asrBottom
Left = 233
Height = 23
Top = 50
Width = 195
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 2
Text = 'RowEdit'
end
object ColEdit: TEdit
AnchorSideLeft.Control = ColIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GridDataPage
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ColOut
AnchorSideBottom.Side = asrBottom
Left = 233
Height = 23
Top = 130
Width = 195
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 3
Text = 'ColEdit'
end
object DepEdit: TEdit
AnchorSideLeft.Control = DepIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GridDataPage
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = DepOut
AnchorSideBottom.Side = asrBottom
Left = 233
Height = 23
Top = 210
Width = 195
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 4
Text = 'DepEdit'
end
object NCasesEdit: TEdit
AnchorSideTop.Control = DepOut
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GridDataPage
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 368
Height = 23
Top = 253
Width = 60
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
TabOrder = 5
Text = 'NCasesEdit'
end
object RowOut: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RowIn
AnchorSideTop.Side = asrBottom
Left = 201
Height = 26
Top = 59
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = RowOutClick
Spacing = 0
TabOrder = 6
end
object ColIn: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RowOut
AnchorSideTop.Side = asrBottom
Left = 201
Height = 26
Top = 109
Width = 26
BorderSpacing.Top = 24
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = ColInClick
Spacing = 0
TabOrder = 7
end
object ColOut: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ColIn
AnchorSideTop.Side = asrBottom
Left = 201
Height = 26
Top = 139
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = ColOutClick
Spacing = 0
TabOrder = 8
end
object DepIn: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ColOut
AnchorSideTop.Side = asrBottom
Left = 201
Height = 26
Top = 189
Width = 26
BorderSpacing.Top = 24
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = DepInClick
Spacing = 0
TabOrder = 9
end
object DepOut: TBitBtn
AnchorSideLeft.Control = GridDataPage
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = DepIn
AnchorSideTop.Side = asrBottom
Left = 201
Height = 26
Top = 219
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = DepOutClick
Spacing = 0
TabOrder = 10
end
end
object TableDataPage: TPage
object Panel2: TPanel
AnchorSideLeft.Control = TableDataPage
AnchorSideTop.Control = TableDataPage
Left = 16
Height = 77
Top = 32
Top = 24
Width = 206
Alignment = taRightJustify
AutoSize = True
@ -131,7 +347,7 @@ object FisherFrm: TFisherFrm
ChildSizing.ControlsPerLine = 3
ClientHeight = 77
ClientWidth = 206
TabOrder = 1
TabOrder = 0
object Label5: TLabel
Left = 0
Height = 15
@ -173,7 +389,6 @@ object FisherFrm: TFisherFrm
Top = 23
Width = 80
Alignment = taRightJustify
OnKeyPress = RC11EditKeyPress
TabOrder = 0
Text = 'RC11Edit'
end
@ -183,7 +398,6 @@ object FisherFrm: TFisherFrm
Top = 23
Width = 80
Alignment = taRightJustify
OnKeyPress = RC12EditKeyPress
TabOrder = 1
Text = 'RC12Edit'
end
@ -202,7 +416,6 @@ object FisherFrm: TFisherFrm
Top = 54
Width = 80
Alignment = taRightJustify
OnKeyPress = RC21EditKeyPress
TabOrder = 2
Text = 'RC21Edit'
end
@ -212,274 +425,41 @@ object FisherFrm: TFisherFrm
Top = 54
Width = 80
Alignment = taRightJustify
OnKeyPress = RC22EditKeyPress
TabOrder = 3
Text = 'RC22Edit'
end
end
object Panel1: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = InputGrp
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
end
end
object AlphaEdit: TEdit[7]
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 285
Top = 138
Width = 656
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 16
BorderSpacing.Right = 8
BevelOuter = bvNone
ClientHeight = 285
ClientWidth = 656
TabOrder = 2
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 0
Height = 15
Top = 0
Width = 97
Caption = 'Variables Available'
ParentColor = False
end
object RowLabel: TLabel
AnchorSideLeft.Control = RowEdit
AnchorSideBottom.Control = RowEdit
Left = 350
Height = 15
Top = 25
Width = 67
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Row Variable'
ParentColor = False
end
object ColLabel: TLabel
AnchorSideLeft.Control = ColEdit
AnchorSideBottom.Control = ColEdit
Left = 350
Height = 15
Top = 109
Width = 87
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Column Variable'
ParentColor = False
end
object DepLabel: TLabel
AnchorSideLeft.Control = DepEdit
AnchorSideBottom.Control = DepEdit
Left = 350
Height = 15
Top = 193
Width = 99
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2
Caption = 'Variable to Analyze'
ParentColor = False
end
object NCasesLabel: TLabel
AnchorSideTop.Control = NCasesEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = NCasesEdit
Left = 494
Height = 15
Top = 257
Width = 97
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Total No. of Cases:'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = RowIn
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 268
Top = 17
Width = 306
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0
TabOrder = 0
end
object RowIn: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 314
Height = 28
Top = 17
Width = 28
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = RowInClick
Spacing = 0
TabOrder = 1
end
object RowEdit: TEdit
AnchorSideLeft.Control = RowIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RowOut
AnchorSideBottom.Side = asrBottom
Left = 350
AnchorSideBottom.Control = ButtonBevel
Left = 368
Height = 23
Top = 42
Width = 298
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 2
Text = 'RowEdit'
end
object ColEdit: TEdit
AnchorSideLeft.Control = ColIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ColOut
AnchorSideBottom.Side = asrBottom
Left = 350
Height = 23
Top = 126
Width = 298
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 3
Text = 'ColEdit'
end
object DepEdit: TEdit
AnchorSideLeft.Control = DepIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = DepOut
AnchorSideBottom.Side = asrBottom
Left = 350
Height = 23
Top = 210
Width = 298
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 4
Text = 'DepEdit'
end
object NCasesEdit: TEdit
AnchorSideTop.Control = DepOut
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 599
Height = 23
Top = 253
Width = 49
Top = 444
Width = 60
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 8
TabOrder = 5
Text = 'NCasesEdit'
end
object RowOut: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RowIn
AnchorSideTop.Side = asrBottom
Left = 314
Height = 28
Top = 49
Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = RowOutClick
Spacing = 0
Anchors = [akRight, akBottom]
TabOrder = 6
Text = 'AlphaEdit'
end
object ColIn: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = RowOut
AnchorSideTop.Side = asrBottom
Left = 314
Height = 28
Top = 101
Width = 28
BorderSpacing.Top = 24
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = ColInClick
Spacing = 0
TabOrder = 7
object Label2: TLabel[8]
AnchorSideTop.Control = AlphaEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = AlphaEdit
Left = 210
Height = 15
Top = 448
Width = 150
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Alpha level (Type I Error rate)'
ParentColor = False
end
object ColOut: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ColIn
AnchorSideTop.Side = asrBottom
Left = 314
Height = 28
Top = 133
Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = ColOutClick
Spacing = 0
TabOrder = 8
end
object DepIn: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ColOut
AnchorSideTop.Side = asrBottom
Left = 314
Height = 28
Top = 185
Width = 28
BorderSpacing.Top = 24
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = DepInClick
Spacing = 0
TabOrder = 9
end
object DepOut: TBitBtn
AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = DepIn
AnchorSideTop.Side = asrBottom
Left = 314
Height = 28
Top = 217
Width = 28
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = DepOutClick
Spacing = 0
TabOrder = 10
end
inherited ParamsSplitter: TSplitter
Left = 440
Height = 524
end
end

View File

@ -5,20 +5,21 @@ unit ExactUnit;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib,
Globals, DataProcs, Math;
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, StdCtrls, Buttons,
MainUnit, FunctionsLib, Globals, BasicStatsReportFormUnit;
type
{ TFisherFrm }
TFisherFrm = class(TForm)
Bevel1: TBevel;
TFisherFrm = class(TBasicStatsReportForm)
AlphaEdit: TEdit;
Label2: TLabel;
Label5: TLabel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
Notebook: TNotebook;
GridDataPage: TPage;
TableDataPage: TPage;
RC11Edit: TEdit;
RC12Edit: TEdit;
RC21Edit: TEdit;
@ -45,117 +46,53 @@ type
ColLabel: TLabel;
DepLabel: TLabel;
VarList: TListBox;
Panel1: TPanel;
procedure ColInClick(Sender: TObject);
procedure ColOutClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure DepInClick(Sender: TObject);
procedure DepOutClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure InputGrpClick(Sender: TObject);
procedure RC11EditKeyPress(Sender: TObject; var Key: char);
procedure RC12EditKeyPress(Sender: TObject; var Key: char);
procedure RC21EditKeyPress(Sender: TObject; var Key: char);
procedure RC22EditKeyPress(Sender: TObject; var Key: char);
procedure ResetBtnClick(Sender: TObject);
procedure RowInClick(Sender: TObject);
procedure RowOutClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private
{ private declarations }
FAutoSized: Boolean;
procedure PrintFisherTable(AList: TStrings; A, B, C, D: integer; P, SumP: double);
procedure UpdateBtnStates;
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWinControl): boolean; override;
public
{ public declarations }
procedure Reset; override;
end;
var
FisherFrm: TFisherFrm;
implementation
{$R *.lfm}
uses
Utils, GridProcs;
{ TFisherFrm }
procedure TFisherFrm.ResetBtnClick(Sender: TObject);
var
i: integer;
procedure TFisherFrm.AdjustConstraints;
begin
VarList.Clear;
RowEdit.Text := '';
ColEdit.Text := '';
DepEdit.Text := '';
DepEdit.Visible := false;
DepIn.Visible := false;
DepOut.Visible := false;
NCasesLabel.Visible := false;
DepLabel.Visible := false;
NCasesEdit.Text := '';
NCasesEdit.Visible := false;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
Panel1.Visible := false;
Panel2.Visible := false;
RC11Edit.Text := '';
RC12Edit.Text := '';
RC21Edit.Text := '';
RC22Edit.Text := '';
UpdateBtnStates;
inherited;
ParamsPanel.Constraints.MinWidth := InputGrp.Width;
ParamsPanel.Constraints.MinHeight := InputGrp.Top + InputGrp.Height +
NCasesEdit.Top + NCasesEdit.Height +
Notebook.BorderSpacing.Bottom + AlphaEdit.Height +
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;
procedure TFisherFrm.RowInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (RowEdit.Text = '') then
begin
RowEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TFisherFrm.RowOutClick(Sender: TObject);
begin
if RowEdit.Text <> '' then
begin
VarList.Items.Add(RowEdit.Text);
RowEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TFisherFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
FAutoSized := true;
end;
procedure TFisherFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
end;
procedure TFisherFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TFisherFrm.ColInClick(Sender: TObject);
var
@ -170,6 +107,7 @@ begin
UpdateBtnStates;
end;
procedure TFisherFrm.ColOutClick(Sender: TObject);
begin
if ColEdit.Text <> '' then
@ -180,34 +118,26 @@ begin
UpdateBtnStates;
end;
procedure TFisherFrm.ComputeBtnClick(Sender: TObject);
procedure TFisherFrm.Compute;
var
i, j, row, col, caserow, casecol, A, B, C, D, Largest: integer;
i, j, row, col, caseRow, caseCol, A, B, C, D, largest: integer;
N, APlusB, APlusC, BPlusD, CPlusD, NoSelected, dep: integer;
FirstP, p, SumProb, Tocher, Alpha, X: double;
obs: array[1..2, 1..2] of integer;
ColNoSelected: IntDyneVec = nil;
done, ok: boolean;
response: string;
done: boolean;
lReport: TStrings;
begin
Randomize; // initialize random number generator
row := 0;
col := 0;
dep := 0;
// get column no.s of row and col variables
if InputGrp.ItemIndex <> 3 then
begin
for i := 1 to NoVariables do
begin
if RowEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then row := i;
if ColEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then col := i;
row := GetVariableIndex(OS3MainFrm.DataGrid, RowEdit.Text);
col := GetVariableIndex(OS3MainFrm.DataGrid, ColEdit.Text);
if InputGrp.ItemIndex = 2 then
begin
if DepEdit.Text = OS3MainFrm.DataGrid.Cells[i,0] then dep := i;
end;
end;
dep := GetVariableIndex(OS3MainFrm.DataGrid, DepEdit.Text);
end;
SetLength(ColNoSelected, 3);
@ -219,83 +149,67 @@ begin
NoSelected := 3;
end else
NoSelected := 2;
SetLength(ColNoSelected, noSelected);
//initialize observed matrix
// Initialize observed matrix
for i := 1 to 2 do
for j := 1 to 2 do obs[i,j] := 0;
for j := 1 to 2 do obs[i, j] := 0;
if InputGrp.ItemIndex = 3 then // get freq. from form
begin
if (RC11Edit.Text = '') or not TryStrToInt(RC11Edit.Text, obs[1, 1]) then
begin
RC11Edit.SetFocus;
MessageDlg('No valid input.', mtError, [mbOK], 0);
exit;
end;
if (RC12Edit.Text = '') or not TryStrToInt(RC12Edit.Text, obs[1, 2]) then
begin
RC12Edit.SetFocus;
MessageDlg('No valid input', mtError, [mbOK], 0);
exit;
end;
if (RC21Edit.Text = '') or not TryStrToInt(RC21Edit.Text, obs[2, 1]) then
begin
RC21Edit.SetFocus;
MessageDlg('No valid input.', mtError, [mbOK], 0);
exit;
end;
if (RC22Edit.Text = '') or not TryStrToInt(RC22Edit.Text, obs[2, 2]) then
begin
RC22Edit.SetFocus;
MessageDlg('No valid input', mtError, [mbOK], 0);
exit;
end;
end;
if InputGrp.ItemIndex = 0 then // count no. in row/col combinations
// Count no. in row/col combinations
if InputGrp.ItemIndex = 0 then
begin
for j := 1 to NoCases do
begin
if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue;
caserow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row,j])));
casecol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j])));
if (caserow > 2) or (caserow < 1) then
if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
caseRow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row, j])));
caseCol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, j])));
if (caseRow > 2) or (caseRow < 1) then
begin
MessageDlg('Row < 1 or > 2 found. Case ignored.', mtInformation, [mbOK], 0);
ErrorMsg('Row < 1 or > 2 found. Case ignored.');
continue;
end;
if (casecol > 2) or (casecol < 1) then
if (caseCol > 2) or (caseCol < 1) then
begin
MessageDlg('Column < 1 or > 2 found. Case ignored.', mtInformation, [mbOK], 0);
ErrorMsg('Column < 1 or > 2 found. Case ignored.');
continue;
end;
obs[caserow, casecol] := obs[caserow, casecol] + 1;
obs[caseRow, caseCol] := obs[caseRow, caseCol] + 1;
end;
end;
if (InputGrp.ItemIndex = 1) or (InputGrp.ItemIndex = 2) then // Grid has frequencies for row/col
// Grid has frequencies for row/col
if (InputGrp.ItemIndex = 1) or (InputGrp.ItemIndex = 2) then
begin
for j := 1 to NoCases do
begin
if (not GoodRecord(j,NoSelected,ColNoSelected)) then continue;
caserow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row,j])));
casecol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j])));
if (caserow > 2) or (caserow < 1) then
if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
caseRow := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[row, j])));
caseCol := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, j])));
if (caseRow > 2) or (caseRow < 1) then
begin
MessageDlg('Row < 1 or > 2 found. Case ignored.', mtInformation, [mbOk], 0);
ErrorMsg('Row < 1 or > 2 found. Case ignored.');
continue;
end;
if (casecol > 2) or (casecol < 1) then
if (caseCol > 2) or (caseCol < 1) then
begin
MessageDlg('Column < 1 or > 2 found. Case ignored.', mtError, [mbOK], 0);
ErrorMsg('Column < 1 or > 2 found. Case ignored.');
continue;
end;
obs[caserow, casecol] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep,j])));
obs[caseRow, caseCol] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[dep, j])));
if InputGrp.ItemIndex = 2 then
obs[caserow,casecol] := obs[caserow,casecol] * StrToInt(NCasesEdit.Text);
obs[caseRow, caseCol] := obs[caseRow, caseCol] * StrToInt(NCasesEdit.Text);
end;
end;
// Get freq. from form
if InputGrp.ItemIndex = 3 then
begin
obs[1, 1] := StrToInt(RC11Edit.Text);
obs[1, 2] := StrToInt(RC12Edit.Text);
obs[2, 1] := StrToInt(RC21Edit.Text);
obs[2, 2] := StrToInt(RC22Edit.Text);
end;
//Find smallest value
A := obs[1, 1];
B := obs[1, 2];
@ -306,11 +220,11 @@ begin
BPlusD := B + D;
APlusC := A + C;
N := A + B + C + D;
Largest := 1;
largest := 1;
if (B > A) then largest := 2;
if ((B > A) and (B > C) and (B > D)) then Largest := 2;
if ((C > A) and (C > B) and (C > D)) then Largest := 3;
if ((D > A) and (D > B) and (D > C)) then Largest := 4;
if ((B > A) and (B > C) and (B > D)) then largest := 2;
if ((C > A) and (C > B) and (C > D)) then largest := 3;
if ((D > A) and (D > B) and (D > C)) then largest := 4;
// Ready for output
lReport := TStringList.Create;
@ -328,7 +242,7 @@ begin
done := false;
while (not done) do
begin
case Largest of
case largest of
1: begin// top row, first col
if (A = APlusB) then
done := true
@ -385,33 +299,28 @@ begin
end;
//Tocher's modification
repeat
response := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
ok := InputQuery('Alpha', 'Enter your Alpha level (Type I Error rate): ', response);
if not ok then
exit;
if TryStrToFloat(response, Alpha) then
break
else
MessageDlg('Not a valid number.', mtError, [mbOk], 0);
until false;
alpha := StrToFloat(AlphaEdit.Text);
if ((SumProb - FirstP) > Alpha) then //Extreme values > alpha - accept null hypothesis
// Extreme values > alpha - accept null hypothesis
if ((sumProb - FirstP) > alpha) then
lReport.Add('Null hypothesis accepted.')
else
begin//Extreme values significant - is total probability significant?
if (SumProb >= Alpha) then //No, so apply Tocher's rule
begin
Tocher := ( Alpha - (SumProb - FirstP)) / FirstP;
X := random(1000) / 1000.0; //Select a random value between 0 and num - 1
// Extreme values significant - is total probability significant?
if (sumProb >= Alpha) then //No, so apply Tocher's rule
begin
Tocher := ( Alpha - (sumProb - FirstP)) / FirstP;
X := random(1000) / 1000.0; //Select a random value between 0 and num - 1 // wp: why not simply X := random()
lReport.Add('Tocher ratio computed: %5.3f', [Tocher]);
if (X < Tocher) then //Call it significant
begin
lReport.Add('A random value of %5.3f selected was less than the Tocher value.', [X]);
lReport.Add('');
lReport.Add('Conclusion: Reject the null Hypothesis');
end else
begin //Call it non-significant
lReport.Add('A random value of %5.3f selected was greater than the Tocher value.', [X]);
lReport.Add('');
lReport.Add('Conclusion: Accept the null Hypothesis');
end;
end else
@ -420,14 +329,14 @@ begin
end; // end if-else
end; // end if-else
OutputFrm.Clear;
OutputFrm.AddLines(lReport);
OutputFrm.ShowModal;
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;
end;
procedure TFisherFrm.DepInClick(Sender: TObject);
var
index: integer;
@ -441,6 +350,7 @@ begin
UpdateBtnStates;
end;
procedure TFisherFrm.DepOutClick(Sender: TObject);
begin
if DepEdit.Text <> '' then
@ -451,17 +361,20 @@ begin
UpdateBtnStates;
end;
procedure TFisherFrm.InputGrpClick(Sender: TObject);
begin
if InputGrp.ItemIndex = 3 then
begin
Panel2.Visible := true;
Panel1.Visible := false;
RC11Edit.SetFocus;
Notebook.PageIndex := 1;
// Panel2.Visible := true;
// Panel1.Visible := false;
//RC11Edit.SetFocus; // <!!!!!!!!!!!!!!!!!!!!!!!!!!!! Fix me
end else
begin
Panel1.Visible := true;
Panel2.Visible := false;
Notebook.PageIndex := 0;
// Panel1.Visible := true;
// Panel2.Visible := false;
ColIn.Enabled := true;
ColOut.Enabled := false;
if InputGrp.ItemIndex = 2 then
@ -491,25 +404,6 @@ begin
end;
end;
procedure TFisherFrm.RC11EditKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then RC12Edit.SetFocus;
end;
procedure TFisherFrm.RC12EditKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then RC21Edit.SetFocus;
end;
procedure TFisherFrm.RC21EditKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then RC22Edit.SetFocus;
end;
procedure TFisherFrm.RC22EditKeyPress(Sender: TObject; var Key: char);
begin
if Key = #13 then ComputeBtn.SetFocus;
end;
procedure TFisherFrm.PrintFisherTable(AList: TStrings;
A, B, C, D: integer; P, SumP: double);
@ -520,13 +414,153 @@ begin
AList.Add(' 1 %10d %10d', [A, B]);
AList.Add(' 2 %10d %10d', [C, D]);
AList.Add('');
AList.Add('Probability = %6.4f', [P]);
AList.Add('Cumulative Probability = %6.4f', [SumP]);
AList.Add('Probability: %8.4f', [P]);
AList.Add('Cumulative Probability: %8.4f', [SumP]);
AList.Add('');
end;
procedure TFisherFrm.Reset;
var
i: integer;
begin
inherited;
Notebook.PageIndex := -1;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
RowEdit.Clear;
ColEdit.Clear;
DepEdit.Clear;
DepEdit.Visible := false;
DepIn.Visible := false;
DepOut.Visible := false;
DepLabel.Visible := false;
NCasesLabel.Visible := false;
NCasesEdit.Clear;
NCasesEdit.Visible := false;
RC11Edit.Clear;
RC12Edit.Clear;
RC21Edit.Clear;
RC22Edit.Clear;
AlphaEdit.Text := FormatFloat('0.00', DEFAULT_ALPHA_LEVEL);
UpdateBtnStates;
end;
procedure TFisherFrm.RowInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (RowEdit.Text = '') then
begin
RowEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TFisherFrm.RowOutClick(Sender: TObject);
begin
if RowEdit.Text <> '' then
begin
VarList.Items.Add(RowEdit.Text);
RowEdit.Text := '';
end;
UpdateBtnStates;
end;
function TFisherFrm.Validate(out AMsg: String; out AControl: TWinControl): boolean;
var
x: Double;
n: Integer;
begin
Result := false;
if InputGrp.ItemIndex = 3 then
begin
if (RC11Edit.Text = '') or not TryStrToInt(RC11Edit.Text, n) then
begin
AControl := RC11Edit;
AMsg := 'No valid input.';
exit;
end;
if (RC12Edit.Text = '') or not TryStrToInt(RC12Edit.Text, n) then
begin
AControl := RC12Edit;
AMsg := 'No valid input';
exit;
end;
if (RC21Edit.Text = '') or not TryStrToInt(RC21Edit.Text, n) then
begin
AControl := RC21Edit;
AMsg := 'No valid input.';
exit;
end;
if (RC22Edit.Text = '') or not TryStrToInt(RC22Edit.Text, n) then
begin
AControl := RC22Edit;
AMsg := 'No valid input';
exit;
end;
end;
if AlphaEdit.Text = '' then
begin
AMsg := 'Input required.';
AControl := AlphaEdit;
exit;
end;
if not TryStrToFloat(AlphaEdit.Text, x) or (x < 0) or (x > 1) then
begin
AMsg := 'Numerical value between 0 and 1 required.';
AControl := AlphaEdit;
exit;
end;
Result := true;
end;
procedure TFisherFrm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
s := VarList.Items[index];
if RowEdit.Text = '' then
RowEdit.Text := s
else if ColEdit.Text = '' then
ColEdit.Text := s
else if (DepEdit.Text = '') and (InputGrp.ItemIndex in [1, 2]) then
DepEdit.Text := s;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TFisherFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TFisherFrm.UpdateBtnStates;
begin
inherited;
RowIn.Enabled := VarList.ItemIndex > -1;
ColIn.Enabled := VarList.ItemIndex > -1;
DepIn.Enabled := VarList.ItemIndex > -1;
@ -535,8 +569,6 @@ begin
DepOut.Enabled := DepEdit.Text <> '';
end;
initialization
{$I exactunit.lrs}
end.