LazStats: Inherit MannWhitUUnit from TBasicStatsReportForm

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7812 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-26 16:56:17 +00:00
parent 02db991125
commit c0b84b8908
6 changed files with 472 additions and 532 deletions

View File

@ -721,7 +721,7 @@
<Unit77>
<Filename Value="forms\analysis\nonparametric\mannwhituunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MannWhitUFrm"/>
<ComponentName Value="MannWhitUForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MannWhitUUnit"/>

View File

@ -1,37 +1,47 @@
object MannWhitUFrm: TMannWhitUFrm
inherited MannWhitUForm: TMannWhitUForm
Left = 540
Height = 321
Height = 400
Top = 256
Width = 373
Width = 654
HelpType = htKeyword
HelpKeyword = 'html/Mann-WhitneyUTest.htm'
AutoSize = True
Caption = 'Mann-Whitney U Test'
ClientHeight = 321
ClientWidth = 373
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '2.1.0.0'
object Label1: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 8
ClientHeight = 400
ClientWidth = 654
inherited ParamsPanel: TPanel
Height = 384
ClientHeight = 384
inherited CloseBtn: TButton
Top = 359
end
inherited ComputeBtn: TButton
Top = 359
end
inherited ResetBtn: TButton
Top = 359
end
inherited HelpBtn: TButton
Top = 359
end
inherited ButtonBevel: TBevel
Top = 343
end
object Label1: TLabel[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
Left = 0
Height = 15
Top = 8
Top = 0
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Variables Available'
Caption = 'Available Variables'
ParentColor = False
end
object Label2: TLabel
object Label2: TLabel[6]
AnchorSideLeft.Control = GrpEdit
AnchorSideBottom.Control = GrpEdit
Left = 245
Left = 164
Height = 15
Top = 33
Top = 21
Width = 77
Anchors = [akLeft, akBottom]
BorderSpacing.Right = 8
@ -39,12 +49,12 @@ object MannWhitUFrm: TMannWhitUFrm
Caption = 'Group Variable'
ParentColor = False
end
object Label3: TLabel
object Label3: TLabel[7]
AnchorSideLeft.Control = DepEdit
AnchorSideBottom.Control = DepEdit
Left = 245
Left = 164
Height = 15
Top = 125
Top = 109
Width = 102
Anchors = [akLeft, akBottom]
BorderSpacing.Right = 8
@ -52,198 +62,125 @@ object MannWhitUFrm: TMannWhitUFrm
Caption = 'Dependent Variable'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = Owner
object VarList: TListBox[8]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GrpIn
AnchorSideBottom.Control = Bevel2
Left = 8
Height = 247
Top = 25
Width = 193
AnchorSideBottom.Control = ButtonBevel
Left = 0
Height = 326
Top = 17
Width = 126
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
Constraints.MinHeight = 200
BorderSpacing.Right = 6
ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0
TabOrder = 4
end
object GrpIn: TBitBtn
AnchorSideLeft.Control = Bevel3
AnchorSideLeft.Side = asrBottom
object GrpIn: TBitBtn[9]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 209
Height = 28
Top = 25
Width = 28
Left = 132
Height = 26
Top = 17
Width = 26
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = GrpInClick
Spacing = 0
TabOrder = 1
TabOrder = 5
end
object GrpOut: TBitBtn
AnchorSideLeft.Control = Bevel3
AnchorSideLeft.Side = asrBottom
object GrpOut: TBitBtn[10]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GrpIn
AnchorSideTop.Side = asrBottom
Left = 209
Height = 28
Top = 57
Width = 28
Left = 132
Height = 26
Top = 47
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = GrpOutClick
Spacing = 0
TabOrder = 2
TabOrder = 6
end
object DepIn: TBitBtn
AnchorSideLeft.Control = Bevel3
AnchorSideLeft.Side = asrBottom
object DepIn: TBitBtn[11]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = GrpOut
AnchorSideTop.Side = asrBottom
Left = 209
Height = 28
Top = 117
Width = 28
Left = 132
Height = 26
Top = 105
Width = 26
BorderSpacing.Top = 32
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = DepInClick
Spacing = 0
TabOrder = 3
TabOrder = 7
end
object DepOut: TBitBtn
AnchorSideLeft.Control = Bevel3
AnchorSideLeft.Side = asrBottom
object DepOut: TBitBtn[12]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = DepIn
AnchorSideTop.Side = asrBottom
Left = 209
Height = 28
Top = 149
Width = 28
Left = 132
Height = 26
Top = 135
Width = 26
BorderSpacing.Top = 4
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = DepOutClick
Spacing = 0
TabOrder = 4
TabOrder = 8
end
object GrpEdit: TEdit
object GrpEdit: TEdit[13]
AnchorSideLeft.Control = GrpIn
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = GrpOut
AnchorSideBottom.Side = asrBottom
Left = 245
Left = 164
Height = 23
Top = 50
Width = 120
Top = 38
Width = 127
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Left = 6
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 5
TabOrder = 9
Text = 'GrpEdit'
end
object DepEdit: TEdit
object DepEdit: TEdit[14]
AnchorSideLeft.Control = DepIn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = DepOut
AnchorSideBottom.Side = asrBottom
Left = 245
Left = 164
Height = 23
Top = 142
Width = 120
Top = 126
Width = 127
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Left = 6
BorderSpacing.Bottom = 12
ReadOnly = True
TabOrder = 6
Text = 'Edit1'
end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 164
Height = 25
Top = 288
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 7
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 226
Height = 25
Top = 288
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 8
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 310
Height = 25
Top = 288
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 9
end
object Bevel2: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 272
Width = 373
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Bevel3: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 163
Height = 11
Top = 7
Width = 46
Shape = bsSpacer
TabOrder = 10
Text = 'DepEdit'
end
end
inherited ParamsSplitter: TSplitter
Height = 400
end
end

View File

@ -7,106 +7,76 @@ unit MannWhitUUnit;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls,
MainUnit, OutputUnit, FunctionslIB, Globals, DataProcs;
MainUnit, FunctionslIB, Globals, DataProcs, BasicStatsReportFormUnit;
type
{ TMannWhitUFrm }
{ TMannWhitUForm }
TMannWhitUFrm = class(TForm)
Bevel2: TBevel;
TMannWhitUForm = class(TBasicStatsReportForm)
Bevel3: TBevel;
GrpIn: TBitBtn;
GrpOut: TBitBtn;
DepIn: TBitBtn;
DepOut: TBitBtn;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
GrpEdit: TEdit;
DepEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
VarList: TListBox;
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 GrpInClick(Sender: TObject);
procedure GrpOutClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private
{ private declarations }
FAutoSized: Boolean;
procedure UpdateBtnStates;
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public
{ public declarations }
procedure Reset; override;
end;
var
MannWhitUFrm: TMannWhitUFrm;
MannWhitUForm: TMannWhitUForm;
implementation
{$R *.lfm}
uses
Math;
Math,
Utils;
{ TMannWhitUFrm }
{ TMannWhitUForm }
procedure TMannWhitUFrm.ResetBtnClick(Sender: TObject);
var
i: integer;
begin
GrpEdit.Text := '';
DepEdit.Text := '';
VarList.Items.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;
procedure TMannWhitUFrm.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 := (Label3.Width + GrpIn.Width + 2 * VarList.BorderSpacing.Left + Bevel3.Width div 2) * 2;
Constraints.MinHeight := Height;
FAutoSized := true;
end;
procedure TMannWhitUFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TMannWhitUFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TMannWhitUFrm.ComputeBtnClick(Sender: TObject);
procedure TMannWhitUForm.AdjustConstraints;
begin
inherited;
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
ParamsPanel.Constraints.MinHeight := DepOut.Top + DepOut.Height +
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;
procedure TMannWhitUForm.Compute;
var
ColNoSelected: IntDyneVec = nil;
group_count: IntdyneVec = nil;
Ranks: DblDyneMat = nil;
X: DblDyneMat = nil;
RankSums: DblDyneVec = nil;
i, j, ind_var, dep_var, min_grp, max_grp, group, total_n : integer;
NoTies, NoTieGroups, n1, n2, nogroups, largestn : integer;
NoSelected : integer;
ColNoSelected : IntDyneVec;
group_count : IntdyneVec;
Ranks, X : DblDyneMat;
RankSums : DblDyneVec;
TieSum, score, t, SumT, Avg, z, prob, U, U2, SD, Temp : double;
cellstring, outline : string;
lReport: TStrings;
@ -120,7 +90,7 @@ begin
// Check for data
if (NoVariables < 1) then
begin
MessageDlg('You must have grid data!', mtError, [mbOK], 0);
ErrorMsg('You must have grid data!');
exit;
end;
@ -141,18 +111,18 @@ begin
ColNoSelected[1] := dep_var;
if ind_var = 0 then
begin
MessageDlg('No group variable.', mtError, [mbOK], 0);
ErrorMsg('No group variable.');
exit;
end;
if dep_var = 0 then
begin
MessageDlg('No dependent variable.', mtError, [mbOk], 0);
ErrorMsg('No dependent variable.');
exit;
end;
//get minimum and maximum group codes
min_grp := 10000;
max_grp := -10000;
min_grp := MaxInt;
max_grp := -MaxInt;
for i := 1 to NoCases do
begin
if (not GoodRecord(i, NoSelected, ColNoSelected)) then continue;
@ -190,7 +160,7 @@ begin
group := group - min_grp + 1;
if (group > 2) then
begin
MessageDlg('Group codes must be 1 and 2!', mtError, [mbOk], 0);
ErrorMsg('Group codes must be 1 and 2!');
exit;
end;
group_count[group-1] := group_count[group-1] + 1;
@ -312,19 +282,16 @@ begin
lReport.Add('z test is approximate. Use tables of exact probabilities in Siegel.');
lReport.Add('(Table J or K, pages 271-277)');
end;
DisplayReport(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
group_count := nil;
X := nil;
Ranks := nil;
RankSums := nil;
ColNoSelected := nil;
end;
end;
procedure TMannWhitUFrm.DepInClick(Sender: TObject);
procedure TMannWhitUForm.DepInClick(Sender: TObject);
var
index: integer;
begin
@ -337,7 +304,8 @@ begin
UpdateBtnStates;
end;
procedure TMannWhitUFrm.DepOutClick(Sender: TObject);
procedure TMannWhitUForm.DepOutClick(Sender: TObject);
begin
if DepEdit.Text <> '' then
begin
@ -347,7 +315,8 @@ begin
UpdateBtnStates;
end;
procedure TMannWhitUFrm.GrpInClick(Sender: TObject);
procedure TMannWhitUForm.GrpInClick(Sender: TObject);
var
index: integer;
begin
@ -360,7 +329,8 @@ begin
UpdateBtnStates;
end;
procedure TMannWhitUFrm.GrpOutClick(Sender: TObject);
procedure TMannWhitUForm.GrpOutClick(Sender: TObject);
begin
if GrpEdit.Text <> '' then
begin
@ -370,21 +340,54 @@ begin
UpdateBtnStates;
end;
procedure TMannWhitUFrm.UpdateBtnStates;
procedure TMannWhitUForm.Reset;
var
i: integer;
begin
inherited;
GrpEdit.Clear;
DepEdit.clear;
VarList.Items.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;
procedure TMannWhitUForm.UpdateBtnStates;
begin
inherited;
GrpIn.Enabled := (VarList.ItemIndex > -1) and (GrpEdit.Text = '');
DepIn.Enabled := (VarList.ItemIndex > -1) and (DepEdit.Text = '');
GrpOut.Enabled := GrpEdit.Text <> '';
DepOut.Enabled := DepEdit.Text <> '';
end;
procedure TMannWhitUFrm.VarListSelectionChange(Sender: TObject; User: boolean);
procedure TMannWhitUForm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
s := VarList.Items[index];
if GrpEdit.Text = '' then
GrpEdit.Text := s
else if DepEdit.Text = '' then
DepEdit.Text := s;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TMannWhitUForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
initialization
{$I mannwhituunit.lrs}
end.

View File

@ -1,7 +1,7 @@
object runstestform: Trunstestform
Left = 476
Left = 1138
Height = 438
Top = 209
Top = 277
Width = 376
HelpType = htKeyword
HelpKeyword = 'html/RunsTestforNormality.htm'

View File

@ -1,32 +1,32 @@
inherited SignTestFrm: TSignTestFrm
Left = 550
Height = 345
Height = 344
Top = 297
Width = 382
Width = 561
Caption = 'The Matched Pairs Sign Test'
ClientHeight = 345
ClientWidth = 382
ClientHeight = 344
ClientWidth = 561
inherited ParamsPanel: TPanel
Height = 329
ClientHeight = 329
Height = 328
ClientHeight = 328
inherited CloseBtn: TButton
Top = 304
Top = 303
TabOrder = 10
end
inherited ComputeBtn: TButton
Top = 304
Top = 303
TabOrder = 9
end
inherited ResetBtn: TButton
Top = 304
Top = 303
TabOrder = 8
end
inherited HelpBtn: TButton
Top = 304
Top = 303
TabOrder = 7
end
inherited ButtonBevel: TBevel
Top = 288
Top = 287
end
object Label1: TLabel[5]
AnchorSideLeft.Control = ParamsPanel
@ -69,7 +69,7 @@ inherited SignTestFrm: TSignTestFrm
AnchorSideRight.Control = Var1In
AnchorSideBottom.Control = ButtonBevel
Left = 0
Height = 271
Height = 270
Top = 17
Width = 126
Anchors = [akTop, akLeft, akRight, akBottom]
@ -180,6 +180,6 @@ inherited SignTestFrm: TSignTestFrm
end
end
inherited ParamsSplitter: TSplitter
Height = 345
Height = 344
end
end

View File

@ -1824,9 +1824,9 @@ end;
// Menu "Analysis" > "Nonparametric" > "Mann-Whitney U Test"
procedure TOS3MainFrm.mnuAnalysisNonPar_MannWhitneyClick(Sender: TObject);
begin
if MannWhitUFrm = nil then
Application.CreateForm(TMannWhitUFrm, MannWhitUFrm);
MannWhitUFrm.ShowModal;
if MannWhitUForm = nil then
Application.CreateForm(TMannWhitUForm, MannWhitUForm);
MannWhitUForm.Show;
end;
// Menu "Analysis" > "Nonparametric" > "Fisher's Exact Text"