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

LazStats: Inherit form of SpearmanUnit from TBasicStatsReportForm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7808 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-26 11:56:26 +00:00
parent e8845a74d3
commit 42b9a85a01
2 changed files with 300 additions and 359 deletions
Download Patch File Download Diff File Expand all files Collapse all files

243
applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.lfm
View File

@ -1,248 +1,185 @@
object SpearmanFrm: TSpearmanFrm inherited SpearmanFrm: TSpearmanFrm
Left = 531 Left = 531
Height = 317 Height = 347
Top = 246 Top = 246
Width = 347 Width = 679
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/SpearmanRankCorrelation.htm' HelpKeyword = 'html/SpearmanRankCorrelation.htm'
AutoSize = True
Caption = 'Spearman Rank Correlation' Caption = 'Spearman Rank Correlation'
ClientHeight = 317 ClientHeight = 347
ClientWidth = 347 ClientWidth = 679
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate Height = 331
OnShow = FormShow ClientHeight = 331
Position = poMainFormCenter inherited CloseBtn: TButton
LCLVersion = '2.1.0.0' Top = 306
object Label1: TLabel end
AnchorSideLeft.Control = Owner inherited ComputeBtn: TButton
AnchorSideTop.Control = Owner Top = 306
Left = 8 end
inherited ResetBtn: TButton
Top = 306
end
inherited HelpBtn: TButton
Top = 306
end
inherited ButtonBevel: TBevel
Top = 290
end
object Label1: TLabel[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
Left = 0
Height = 15 Height = 15
Top = 8 Top = 0
Width = 97 Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Variables Available' Caption = 'Variables Available'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel[6]
AnchorSideLeft.Control = XEdit AnchorSideLeft.Control = XEdit
AnchorSideBottom.Control = XEdit AnchorSideBottom.Control = XEdit
Left = 233 Left = 166
Height = 15 Height = 15
Top = 33 Top = 21
Width = 51 Width = 51
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'X Variable' Caption = 'X Variable'
ParentColor = False ParentColor = False
end end
object Label3: TLabel object Label3: TLabel[7]
AnchorSideLeft.Control = YEdit AnchorSideLeft.Control = YEdit
AnchorSideBottom.Control = YEdit AnchorSideBottom.Control = YEdit
Left = 233 Left = 166
Height = 15 Height = 15
Top = 125 Top = 109
Width = 51 Width = 51
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Y Variable' Caption = 'Y Variable'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[8]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = XIn AnchorSideRight.Control = XIn
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 0
Height = 243 Height = 273
Top = 25 Top = 17
Width = 181 Width = 126
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
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Constraints.MinHeight = 200
ItemHeight = 0 ItemHeight = 0
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 4
end end
object XIn: TBitBtn object XIn: TBitBtn[9]
AnchorSideLeft.Control = Bevel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
Left = 197 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 = XInClick OnClick = XInClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 5
end end
object XOut: TBitBtn object XOut: TBitBtn[10]
AnchorSideLeft.Control = Bevel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = XIn AnchorSideTop.Control = XIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 197 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
OnClick = XOutClick OnClick = XOutClick
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 6
end end
object YIn: TBitBtn object YIn: TBitBtn[11]
AnchorSideLeft.Control = Bevel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = XOut AnchorSideTop.Control = XOut
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 197 Left = 132
Height = 28 Height = 26
Top = 117 Top = 105
Width = 28 Width = 26
BorderSpacing.Top = 32 BorderSpacing.Top = 32
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = YInClick OnClick = YInClick
Spacing = 0 Spacing = 0
TabOrder = 3 TabOrder = 7
end end
object YOut: TBitBtn object YOut: TBitBtn[12]
AnchorSideLeft.Control = Bevel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = YIn AnchorSideTop.Control = YIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 197 Left = 132
Height = 28 Height = 26
Top = 149 Top = 135
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
OnClick = YOutClick OnClick = YOutClick
Spacing = 0 Spacing = 0
TabOrder = 4 TabOrder = 8
end end
object XEdit: TEdit object XEdit: TEdit[13]
AnchorSideLeft.Control = XIn AnchorSideLeft.Control = XIn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = XOut AnchorSideBottom.Control = XOut
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 233 Left = 166
Height = 23 Height = 23
Top = 50 Top = 38
Width = 106 Width = 125
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
TabOrder = 5 TabOrder = 9
Text = 'XEdit' Text = 'XEdit'
end end
object YEdit: TEdit object YEdit: TEdit[14]
AnchorSideLeft.Control = YOut AnchorSideLeft.Control = YOut
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = YOut AnchorSideBottom.Control = YOut
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 233 Left = 166
Height = 23 Height = 23
Top = 142 Top = 126
Width = 106 Width = 125
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 12 BorderSpacing.Bottom = 12
ReadOnly = True ReadOnly = True
TabOrder = 6 TabOrder = 10
Text = 'YEdit' Text = 'YEdit'
end end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 138
Height = 25
Top = 284
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 end
object ComputeBtn: TButton inherited ParamsSplitter: TSplitter
AnchorSideRight.Control = CloseBtn Height = 347
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 200
Height = 25
Top = 284
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 = 284
Height = 25
Top = 284
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 9
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ComputeBtn
Left = 0
Height = 8
Top = 268
Width = 347
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Bevel2: TBevel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
Left = 150
Height = 11
Top = 3
Width = 47
Shape = bsSpacer
end end
end end

238
applications/lazstats/source/forms/analysis/nonparametric/spearmanunit.pas
View File

@ -5,134 +5,81 @@ unit SpearmanUnit;
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, OutputUnit, FunctionsLib, Globals, DataProcs; MainUnit, FunctionsLib, Globals, DataProcs, BasicStatsReportFormUnit;
type type
{ TSpearmanFrm } { TSpearmanFrm }
TSpearmanFrm = class(TForm) TSpearmanFrm = class(TBasicStatsReportForm)
Bevel1: TBevel; Bevel1: TBevel;
Bevel2: TBevel;
XIn: TBitBtn; XIn: TBitBtn;
XOut: TBitBtn; XOut: TBitBtn;
YIn: TBitBtn; YIn: TBitBtn;
YOut: TBitBtn; YOut: TBitBtn;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
XEdit: TEdit; XEdit: TEdit;
YEdit: TEdit; YEdit: TEdit;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
VarList: TListBox; VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject); procedure VarListDblClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
procedure XInClick(Sender: TObject); procedure XInClick(Sender: TObject);
procedure XOutClick(Sender: TObject); procedure XOutClick(Sender: TObject);
procedure YInClick(Sender: TObject); procedure YInClick(Sender: TObject);
procedure YOutClick(Sender: TObject); procedure YOutClick(Sender: TObject);
private private
{ private declarations }
FAutoSized: Boolean; protected
procedure UpdateBtnStates; procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public public
{ public declarations } procedure Reset; override;
end; end;
var var
SpearmanFrm: TSpearmanFrm; SpearmanFrm: TSpearmanFrm;
implementation implementation
{$R *.lfm}
uses uses
Math, MathUnit; Math, MathUnit;
{ TSpearmanFrm } { TSpearmanFrm }
procedure TSpearmanFrm.ResetBtnClick(Sender: TObject); procedure TSpearmanFrm.AdjustConstraints;
begin
inherited;
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
ParamsPanel.Constraints.MinHeight := YOut.Top + YOut.Height +
VarList.BorderSpacing.Bottom + ButtonBevel.Height +
CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;
procedure TSpearmanFrm.Compute;
var var
i: integer; index: IntDyneMat = nil;
begin Ranks: DblDyneMat = nil;
XEdit.Text := ''; X: DblDyneMat;
YEdit.Text := ''; d: DblDyneVec = nil;
VarList.Items.Clear; ColNoSelected: IntDyneVec = nil;
for i := 1 to NoVariables do ColLabels: StrDyneVec = nil;
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); i, j, itemp, NoTies, NoSelected: integer;
UpdateBtnStates; col1, col2, NCases: integer;
end; Probability, sumsqrx, sumsqry, Temp, TieSum, Avg, t, SumT, r: double;
z, sumdsqr, df: double;
procedure TSpearmanFrm.XInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (XEdit.Text = '') then
begin
XEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.XOutClick(Sender: TObject);
begin
if XEdit.Text <> '' then
begin
VarList.Items.Add(XEdit.Text);
XEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.YInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (YEdit.Text = '') then
begin
YEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.YOutClick(Sender: TObject);
begin
if YEdit.Text <> '' then
begin
VarList.Items.Add(YEdit.Text);
YEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TSpearmanFrm.ComputeBtnClick(Sender: TObject);
var
i, j, itemp, NoTies, NoSelected : integer;
col1, col2, NCases : integer;
index : IntDyneMat;
Probability, sumsqrx, sumsqry, Temp, TieSum, Avg, t, SumT, r : double;
z, sumdsqr, df : double;
Ranks, X : DblDyneMat;
d : DblDyneVec;
cellstring: string; cellstring: string;
ColNoSelected : IntDyneVec; VarX, VarY, SDX, SDY, MeanX, MeanY, Rxy: double;
ColLabels : StrDyneVec;
VarX, VarY, SDX, SDY, MeanX, MeanY, Rxy : double;
lReport: TStrings; lReport: TStrings;
begin begin
if (XEdit.Text = '') then begin if (XEdit.Text = '') then begin
@ -413,58 +360,115 @@ begin
lReport.Add('Mean X Variance X Std.Dev. X Mean Y Variance Y Std.Dev. Y'); lReport.Add('Mean X Variance X Std.Dev. X Mean Y Variance Y Std.Dev. Y');
lReport.Add('%8.2f %8.2f %8.2f %8.2f %8.2f %8.2f', [MeanX, VarX, SDX, MeanY, VarY, SDY]); lReport.Add('%8.2f %8.2f %8.2f %8.2f %8.2f %8.2f', [MeanX, VarX, SDX, MeanY, VarY, SDY]);
DisplayReport(lReport); FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
ColLabels := nil;
d := nil;
X := nil;
Ranks := nil;
index := nil;
ColNoSelected := nil;
end; end;
end; end;
procedure TSpearmanFrm.FormActivate(Sender: TObject);
procedure TSpearmanFrm.Reset;
var var
w: Integer; i: integer;
begin begin
if FAutoSized then inherited;
exit;
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); XEdit.Text := '';
ResetBtn.Constraints.MinWidth := w; YEdit.Text := '';
ComputeBtn.Constraints.MinWidth := w; VarList.Items.Clear;
CloseBtn.Constraints.MinWidth := w; for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
Constraints.MinWidth := 4*w; UpdateBtnStates;
Constraints.MinHeight := Height;
FAutoSized := true;
end; end;
procedure TSpearmanFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TSpearmanFrm.UpdateBtnStates; procedure TSpearmanFrm.UpdateBtnStates;
begin begin
inherited;
XIn.Enabled := (VarList.Count > 0) and (XEdit.Text = ''); XIn.Enabled := (VarList.Count > 0) and (XEdit.Text = '');
YIn.Enabled := (Varlist.Count > 0) and (YEdit.Text = ''); YIn.Enabled := (Varlist.Count > 0) and (YEdit.Text = '');
XOut.Enabled := XEdit.Text <> ''; XOut.Enabled := XEdit.Text <> '';
YOut.Enabled := YEdit.Text <> ''; YOut.Enabled := YEdit.Text <> '';
end; end;
procedure TSpearmanFrm.VarListSelectionChange(Sender: TObject; User: boolean); procedure TSpearmanFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
initialization
{$I spearmanunit.lrs} procedure TSpearmanFrm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
s := VarList.Items[index];
if XEdit.Text = '' then
XEdit.Text := s
else if YEdit.Text = '' then
YEdit.Text := s;
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TSpearmanFrm.XInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (XEdit.Text = '') then
begin
XEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.XOutClick(Sender: TObject);
begin
if XEdit.Text <> '' then
begin
VarList.Items.Add(XEdit.Text);
XEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.YInClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (YEdit.Text = '') then
begin
YEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TSpearmanFrm.YOutClick(Sender: TObject);
begin
if YEdit.Text <> '' then
begin
VarList.Items.Add(YEdit.Text);
YEdit.Text := '';
end;
UpdateBtnStates;
end;
end. end.