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

LazStats: Inherit CochranQUnit from TBasicStatsReportForm

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7818 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-27 18:06:08 +00:00
parent ffd5f1cc88
commit 8e59f55c29
5 changed files with 261 additions and 320 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
applications/lazstats/source/LazStats.lpi
View File

@ -761,7 +761,7 @@
<Unit82> <Unit82>
<Filename Value="forms\analysis\nonparametric\cochranqunit.pas"/> <Filename Value="forms\analysis\nonparametric\cochranqunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="CochranQFrm"/> <ComponentName Value="CochranQForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="CochranQUnit"/> <UnitName Value="CochranQUnit"/>

1
applications/lazstats/source/forms/analysis/nonparametric/binomialunit.pas
View File

@ -34,6 +34,7 @@ type
var var
BinomialForm: TBinomialForm; BinomialForm: TBinomialForm;
implementation implementation
{$R *.lfm} {$R *.lfm}

215
applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.lfm
View File

@ -1,84 +1,97 @@
object CochranQFrm: TCochranQFrm inherited CochranQForm: TCochranQForm
Left = 562 Left = 562
Height = 344 Height = 393
Top = 203 Top = 203
Width = 414 Width = 810
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/CochranQTest.htm' HelpKeyword = 'html/CochranQTest.htm'
AutoSize = True
Caption = 'Cochran Q Test' Caption = 'Cochran Q Test'
ClientHeight = 344 ClientHeight = 393
ClientWidth = 414 ClientWidth = 810
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate Height = 377
OnShow = FormShow ClientHeight = 377
Position = poMainFormCenter inherited CloseBtn: TButton
LCLVersion = '2.1.0.0' Top = 352
object Label1: TLabel TabOrder = 8
end
inherited ComputeBtn: TButton
Top = 352
TabOrder = 7
end
inherited ResetBtn: TButton
Top = 352
TabOrder = 6
end
inherited HelpBtn: TButton
Top = 352
TabOrder = 5
end
inherited ButtonBevel: TBevel
Top = 336
end
object Label1: TLabel[5]
AnchorSideLeft.Control = VarList AnchorSideLeft.Control = VarList
AnchorSideTop.Control = Owner AnchorSideTop.Control = ParamsPanel
Left = 8 Left = 0
Height = 15 Height = 15
Top = 8 Top = 0
Width = 97 Width = 97
BorderSpacing.Top = 8
Caption = 'Available Variables' Caption = 'Available Variables'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel[6]
AnchorSideLeft.Control = SelList AnchorSideLeft.Control = SelList
AnchorSideTop.Control = Owner AnchorSideTop.Control = ParamsPanel
Left = 238 Left = 171
Height = 15 Height = 15
Top = 8 Top = 0
Width = 93 Width = 93
BorderSpacing.Top = 8
Caption = 'Selected Variables' Caption = 'Selected Variables'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[7]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = AllBtn AnchorSideRight.Control = AllBtn
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 8 Left = 0
Height = 270 Height = 319
Top = 25 Top = 17
Width = 168 Width = 119
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 6
Constraints.MinHeight = 200
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object InBtn: TBitBtn object InBtn: TBitBtn[8]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 193 Left = 132
Height = 28 Height = 26
Top = 25 Top = 17
Width = 28 Width = 26
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = InBtnClick OnClick = InBtnClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 1
end end
object OutBtn: TBitBtn object OutBtn: TBitBtn[9]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = InBtn AnchorSideTop.Control = InBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 193 Left = 132
Height = 28 Height = 26
Top = 57 Top = 47
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
@ -86,126 +99,44 @@ object CochranQFrm: TCochranQFrm
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 2
end end
object AllBtn: TBitBtn object AllBtn: TBitBtn[10]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = OutBtn AnchorSideTop.Control = OutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 184 Left = 125
Height = 25 Height = 25
Top = 89 Top = 77
Width = 46 Width = 40
AutoSize = True AutoSize = True
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'ALL' Caption = 'All'
OnClick = AllBtnClick OnClick = AllBtnClick
TabOrder = 3 TabOrder = 3
end end
object SelList: TListBox object SelList: TListBox[11]
AnchorSideLeft.Control = AllBtn AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 238 Left = 171
Height = 270 Height = 319
Top = 25 Top = 17
Width = 168 Width = 120
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = SelListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 4 TabOrder = 4
end end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 205
Height = 25
Top = 311
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 6
end end
object ComputeBtn: TButton inherited ParamsSplitter: TSplitter
AnchorSideRight.Control = CloseBtn Height = 393
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 267
Height = 25
Top = 311
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 7
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 351
Height = 25
Top = 311
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 8
end
object HelpBtn: TButton
Tag = 113
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 146
Height = 25
Top = 311
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 5
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 295
Width = 414
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end end
end end

229
applications/lazstats/source/forms/analysis/nonparametric/cochranqunit.pas
View File

@ -5,20 +5,15 @@ unit CochranQUnit;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, StdCtrls, Buttons, ExtCtrls,
MainUnit, Globals, OutputUnit, DataProcs, FunctionsLib, contexthelpunit; MainUnit, Globals, FunctionsLib, BasicStatsReportFormUnit;
type type
{ TCochranQFrm } { TCochranQForm }
TCochranQFrm = class(TForm) TCochranQForm = class(TBasicStatsReportForm)
Bevel1: TBevel;
HelpBtn: TButton;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
InBtn: TBitBtn; InBtn: TBitBtn;
Label2: TLabel; Label2: TLabel;
SelList: TListBox; SelList: TListBox;
@ -27,81 +22,47 @@ type
Label1: TLabel; Label1: TLabel;
VarList: TListBox; VarList: TListBox;
procedure AllBtnClick(Sender: TObject); procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure InBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure SelListDblClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private private
{ private declarations }
FAutoSized: Boolean; protected
procedure UpdateBtnStates; procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
public public
{ public declarations } procedure Reset; override;
end; end;
var var
CochranQFrm: TCochranQFrm; CochranQForm: TCochranQForm;
implementation implementation
{$R *.lfm}
uses uses
Math, Utils; Utils, GridProcs;
{ TCochranQFrm }
procedure TCochranQFrm.ResetBtnClick(Sender: TObject); { TCochranQForm }
var
i: integer; procedure TCochranQForm.AdjustConstraints;
begin begin
VarList.Clear; inherited;
SelList.Clear; ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
for i := 1 to NoVariables do ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
UpdateBtnStates;
end; end;
procedure TCochranQFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); procedure TCochranQForm.AllBtnClick(Sender: TObject);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
FAutoSized := true;
end;
procedure TCochranQFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TCochranQFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TCochranQFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TCochranQFrm.AllBtnClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
@ -110,34 +71,24 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TCochranQFrm.ComputeBtnClick(Sender: TObject);
procedure TCochranQForm.Compute;
var var
i, j, k, col: integer; i, j, col: integer;
selCount: Integer;
ColNoSelected: IntDyneVec = nil; ColNoSelected: IntDyneVec = nil;
R1, L1, L2, C1, g1, Q, g2, chiprob: double; R1, L1, L2, C1, g1, Q, g2, chiprob: double;
cellstring: string;
lReport: TStrings; lReport: TStrings;
begin begin
if SelList.Items.Count = 0 then selCount := SelList.Items.Count;
begin SetLength(ColNoSelected, selCount);
MessageDlg('No variable(s) selected.', mtError, [mbOK], 0);
exit;
end;
SetLength(ColNoSelected,NoVariables); // Get column numbers of variables selected
C1 := 0.0; for i := 0 to selCount-1 do
k := SelList.Items.Count; ColNoSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, SelList.Items[i]);
// Get column numbers and labels of variables selected
for i := 1 to k do
begin
cellstring := SelList.Items.Strings[i-1];
for j := 1 to NoVariables do
if (cellstring = OS3MainFrm.DataGrid.Cells[j,0]) then
ColNoSelected[i-1] := j;
end;
// Calculate results // Calculate results
C1 := 0.0;
R1 := 0.0; R1 := 0.0;
L1 := 0.0; L1 := 0.0;
L2 := 0.0; L2 := 0.0;
@ -145,39 +96,39 @@ begin
g2 := 0.0; g2 := 0.0;
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if (not GoodRecord(i,k,ColNoSelected)) then continue; if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
for j := 1 to k do for j := 0 to selCount-1 do
begin begin
col := ColNoSelected[j-1]; col := ColNoSelected[j];
R1 := R1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); R1 := R1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, i]));
end; end;
L1 := L1 + R1; L1 := L1 + R1;
L2 := L2 + (R1 * R1); L2 := L2 + (R1 * R1);
R1 := 0.0; R1 := 0.0;
end; end;
for j := 1 to k do for j := 0 to selCount-1 do
begin begin
for i := 1 to NoCases do for i := 1 to NoCases do
begin begin
if (not GoodRecord(i,k,ColNoSelected)) then continue; if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
col := ColNoSelected[j-1]; col := ColNoSelected[j];
C1 := C1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])); C1 := C1 + StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, i]));
end; end;
g1 := g1 + C1; g1 := g1 + C1;
g2 := g2 + (C1 * C1); g2 := g2 + (C1 * C1);
C1 := 0.0; C1 := 0.0;
end; end;
if (k * L1 - L2) > 0.0 then if (selCount * L1 - L2) > 0.0 then
begin begin
Q := ((k - 1) * ((k * g2) - (g1 * g1))) / ((k * L1) - L2); Q := ((selCount - 1) * ((selCount * g2) - (g1 * g1))) / ((selCount * L1) - L2);
chiprob := 1.0 - chisquaredprob(Q, k - 1); chiProb := 1.0 - ChiSquaredProb(Q, selCount - 1);
end else end else
begin begin
Q := 0.0; Q := 0.0;
chiprob := 1.0; chiProb := 1.0;
Messagedlg('Error in obtaining Q and the probability.', mtError, [mbOK], 0); ErrorMsg('Error in obtaining Q and the probability.');
end; end;
//present results //present results
@ -187,16 +138,17 @@ begin
lReport.Add('See pages 161-166 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences'); lReport.Add('See pages 161-166 in S. Siegel: Nonparametric Statistics for the Behavioral Sciences');
lReport.Add('McGraw-Hill Book Company, New York, 1956'); lReport.Add('McGraw-Hill Book Company, New York, 1956');
lReport.Add(''); lReport.Add('');
lReport.Add('Cochran Q Statistic: %6.3f', [Q]); lReport.Add('Cochran Q Statistic: %.3f', [Q]);
lReport.Add('which is distributed as chi-square with %d D.F. and probability %.4f', [k-1, chiprob]); lReport.Add('which is distributed as chi-square');
DisplayReport(lReport); lReport.Add('with %d degrees of freedum and probability %.4f', [selCount-1, chiProb]);
FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
ColNoSelected := nil;
end; end;
end; end;
procedure TCochranQFrm.InBtnClick(Sender: TObject);
procedure TCochranQForm.InBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -214,7 +166,8 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TCochranQFrm.OutBtnClick(Sender: TObject);
procedure TCochranQForm.OutBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -232,21 +185,77 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TCochranQFrm.UpdateBtnStates;
procedure TCochranQForm.Reset;
var
i: integer;
begin begin
inherited;
VarList.Clear;
SelList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;
procedure TCochranQForm.SelListDblClick(Sender: TObject);
var
index: Integer;
begin
index := SelList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(SelList.Items[index]);
SelList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TCochranQForm.UpdateBtnStates;
begin
inherited;
InBtn.Enabled := AnySelected(VarList); InBtn.Enabled := AnySelected(VarList);
OutBtn.Enabled := AnySelected(SelList); OutBtn.Enabled := AnySelected(SelList);
AllBtn.Enabled := VarList.Items.Count > 0; AllBtn.Enabled := VarList.Items.Count > 0;
end; end;
procedure TCochranQFrm.VarListSelectionChange(Sender: TObject; User: boolean);
function TCochranQForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
begin
Result := false;
if SelList.Items.Count = 0 then
begin
AMsg := 'No variable(s) selected.';
AControl := VarList;
exit;
end;
Result := true;
end;
procedure TCochranQForm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
SelList.Items.Add(VarList.Items[index]);
Varlist.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TCochranQForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
initialization
{$I cochranqunit.lrs}
end. end.

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

@ -1872,9 +1872,9 @@ end;
// Menu "Analysis" > "Nonparametric" > "Cochran Q Test" // Menu "Analysis" > "Nonparametric" > "Cochran Q Test"
procedure TOS3MainFrm.mnuAnalysisNonPar_CochranClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisNonPar_CochranClick(Sender: TObject);
begin begin
if CochranQFrm = nil then if CochranQForm = nil then
Application.CreateForm(TCochranQFrm, CochranQFrm); Application.CreateForm(TCochranQForm, CochranQForm);
CochranQFrm.ShowModal; CochranQForm.Show;
end; end;
// Menu "Analysis" > "Nonparametric" > "Sign Test" // Menu "Analysis" > "Nonparametric" > "Sign Test"