LazStats: Refactor TestGenUnit. Add item to chm file.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7382 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-14 16:05:45 +00:00
parent 6de4d85840
commit 7b48e29ef4
4 changed files with 156 additions and 72 deletions

View File

@ -18,99 +18,85 @@ object TestGenFrm: TTestGenFrm
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrBottom
Left = 63
Height = 70
Left = 57
Height = 72
Top = 151
Width = 210
Width = 222
AutoFill = True
AutoSize = True
BorderSpacing.Top = 12
Caption = 'Generate responses that are:'
ChildSizing.LeftRightSpacing = 6
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 2
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 50
ClientWidth = 206
ClientHeight = 52
ClientWidth = 218
Items.Strings = (
'True / False (dichotomous 0 or 1)'
'Contnuous'
'Continuous'
)
TabOrder = 1
end
object ResetBtn: TButton
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CancelBtn
Left = 31
AnchorSideRight.Control = ComputeBtn
Left = 127
Height = 25
Top = 237
Top = 239
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 16
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 2
end
object CancelBtn: TButton
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ComputeBtn
Left = 97
Height = 25
Top = 237
Width = 62
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 3
end
object ComputeBtn: TButton
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ReturnBtn
Left = 171
AnchorSideRight.Control = CloseBtn
Left = 189
Height = 25
Top = 237
Top = 239
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 4
TabOrder = 3
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 259
Left = 273
Height = 25
Top = 237
Width = 61
Top = 239
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 16
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Return'
ModalResult = 1
TabOrder = 5
Caption = 'Close'
ModalResult = 11
TabOrder = 4
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
@ -120,22 +106,21 @@ object TestGenFrm: TTestGenFrm
AnchorSideRight.Side = asrBottom
Left = 0
Height = 8
Top = 221
Top = 223
Width = 336
Anchors = [akTop, akLeft, akRight]
Shape = bsBottomLine
end
object Panel1: TPanel
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Owner
Left = 12
Left = 16
Height = 139
Top = 0
Width = 312
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Right = 12
BorderSpacing.Left = 16
BorderSpacing.Right = 16
BevelOuter = bvNone
ClientHeight = 139
ClientWidth = 312
@ -144,13 +129,13 @@ object TestGenFrm: TTestGenFrm
AnchorSideTop.Control = NoItemsEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = NoItemsEdit
Left = 22
Left = 17
Height = 15
Top = 12
Width = 206
Width = 211
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Number of item (Variables) to Generate'
Caption = 'Number of items (Variables) to Generate'
ParentColor = False
end
object Label2: TLabel
@ -180,6 +165,7 @@ object TestGenFrm: TTestGenFrm
ParentColor = False
end
object Label4: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = SDEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = SDEdit
@ -187,7 +173,6 @@ object TestGenFrm: TTestGenFrm
Height = 15
Top = 93
Width = 228
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'What is the desired test standard deviation?'
ParentColor = False
@ -233,7 +218,7 @@ object TestGenFrm: TTestGenFrm
BorderSpacing.Top = 4
OnKeyPress = NoCasesEditKeyPress
TabOrder = 1
Text = 'Edit1'
Text = 'NoCasesEdit'
end
object MeanEdit: TEdit
AnchorSideTop.Control = NoCasesEdit
@ -249,9 +234,10 @@ object TestGenFrm: TTestGenFrm
BorderSpacing.Top = 4
OnKeyPress = MeanEditKeyPress
TabOrder = 2
Text = 'Edit1'
Text = 'MeanEdit'
end
object SDEdit: TEdit
AnchorSideLeft.Control = Label4
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = MeanEdit
AnchorSideTop.Side = asrBottom
@ -262,12 +248,11 @@ object TestGenFrm: TTestGenFrm
Top = 89
Width = 76
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 4
OnKeyPress = SDEditKeyPress
TabOrder = 3
Text = 'Edit1'
Text = 'SDEdit'
end
object RelEdit: TEdit
AnchorSideTop.Control = SDEdit
@ -283,7 +268,7 @@ object TestGenFrm: TTestGenFrm
BorderSpacing.Top = 4
OnKeyPress = RelEditKeyPress
TabOrder = 4
Text = 'Edit1'
Text = 'RelEdit'
end
end
end

View File

@ -17,9 +17,8 @@ type
Bevel1: TBevel;
Panel1: TPanel;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
NoItemsEdit: TEdit;
NoCasesEdit: TEdit;
MeanEdit: TEdit;
@ -43,6 +42,7 @@ type
procedure SDEditKeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
function Validate(out AMsg: String; out AControl: TWinControl): Boolean;
public
{ public declarations }
end;
@ -76,19 +76,32 @@ begin
end;
procedure TTestGenFrm.ComputeBtnClick(Sender: TObject);
Var
var
test_var, true_var, total_item_var, true_item_var : double;
error_item_var, true_score, reliability, tempmean : double;
test_stddev, test_mean, X, error_score : double;
random_mean : DblDyneVec;
i, k, no_cases, no_items, itemtype, col : integer;
outline : string;
msg: String;
C: TWinControl;
res: Integer;
begin
if ((NoCases > 0) or (NoVariables > 0)) then
if (NoCases > 0) or (NoVariables > 0) then
begin
ShowMessage('You must first close the current file.');
exit;
res := MessageDlg('You must first close the current file. Close it now?', mtConfirmation, [mbYes, mbNo], 0);
case res of
mrYes: OS3MainFrm.CloseFileBtnClick(nil);
mrNo: exit;
end;
end;
if not Validate(msg, C) then
begin
C.SetFocus;
MessageDlg(msg, mtError, [mbOk], 0);
exit;
end;
itemtype := Options.ItemIndex; // 0 = T-F, 1 = continuous
@ -99,8 +112,7 @@ begin
no_items := StrToInt(NoItemsEdit.Text);
no_cases := StrToInt(NoCasesEdit.Text);
test_mean := StrToFloat(MeanEdit.Text);
total_item_var := (test_var / no_items) * (1.0 -
((no_items - 1) / no_items) * reliability);
total_item_var := (test_var / no_items) * (1.0 - ((no_items - 1) / no_items) * reliability);
true_item_var := total_item_var * reliability;
error_item_var := total_item_var - true_item_var;
tempmean := test_mean / no_items;
@ -119,7 +131,17 @@ begin
outline := format('Item%d',[i]);
DictionaryFrm.DictGrid.RowCount := i;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,col] := outline;
DictionaryFrm.DictGrid.Cells[1, i] := outline;
if itemtype = 0 then
begin
DictionaryFrm.DictGrid.Cells[4, i] := 'I';
DictionaryFrm.DictGrid.Cells[5, i] := '0';
end else
begin
DictionaryFrm.DictGrid.Cells[4, i] := 'F';
DictionaryFrm.DictGrid.Cells[5, i] := '4';
end;
Dictionaryfrm.DictGrid.Cells[7, i] := 'R';
OS3MainFrm.DataGrid.Cells[col,0] := outline;
end;
for i := 1 to no_cases do
@ -133,7 +155,7 @@ begin
end;
for k := 1 to no_cases do
begin
true_score := RandG(0.0,sqrt(true_var));
true_score := RandG(0.0, sqrt(true_var));
true_score := true_score / no_items;
for i := 1 to no_items do
begin
@ -144,8 +166,10 @@ begin
if (X >= random_mean[i-1]) then X := 1.0
else X := 0.0;
end;
if (itemtype = 0) then outline := format('%2.0f',[X])
else outline := format('%6.4f',[X]);
if (itemtype = 0) then
outline := format('%.0f',[X])
else
outline := format('%.4f',[X]);
OS3MainFrm.DataGrid.Cells[i,k] := outline;
end; // end item loop
end; // end case loop
@ -158,7 +182,8 @@ begin
OS3MainFrm.DataGrid.Col := 1;
OS3MainFrm.RowEdit.Text := IntToStr(no_cases);
OS3MainFrm.ColEdit.Text := IntToStr(no_items);
OS3MainFrm.FileNameEdit.Text := 'GenTest.LAZ';
OS3MainFrm.FileNameEdit.Text := 'GenTest.laz';
// clean up the heap
random_mean := nil;
end;
@ -167,11 +192,10 @@ procedure TTestGenFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MaxHeight := Height;
Constraints.MinHeight := Height;
@ -204,6 +228,81 @@ begin
if Ord(Key) = 13 then ComputeBtn.SetFocus;
end;
function TTestGenFrm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var
n: Integer;
x: Double;
begin
Result := false;
if NoItemsEdit.Text = '' then
begin
AControl := NoItemsEdit;
AMsg := 'Number of items not specified.';
exit;
end;
if not (TryStrToInt(NoItemsEdit.Text, n) and (n > 0)) then
begin
AControl := NoItemsEdit;
AMsg := 'Illegal value given for Number of items.';
exit;
end;
if NoCasesEdit.Text = '' then
begin
AControl := NoCasesEdit;
AMsg := 'Number of subjects not specified.';
exit;
end;
if not (TryStrToInt(NoCasesEdit.Text, n) and (n > 0)) then
begin
AControl := NoCasesEdit;
AMsg := 'Illegal value given for Number of subjects.';
exit;
end;
if MeanEdit.Text = '' then
begin
AControl := MeanEdit;
AMsg := 'Mean not specified.';
exit;
end;
if not TryStrToFloat(MeanEdit.Text, x) then
begin
AControl := MeanEdit;
AMsg := 'Numeric input expected for mean.';
exit;
end;
if SDEdit.Text = '' then
begin
AControl := SDEdit;
AMsg := 'Standard deviation not specified.';
exit;
end;
if not (TryStrToFloat(SDEdit.Text, x) and (x > 0)) then
begin
AControl := SDEdit;
AMsg := 'Numeric input expected for standrad deviation.';
exit;
end;
if RelEdit.Text = '' then
begin
AControl := RelEdit;
AMsg := 'Test reliability not specified.';
exit;
end;
if not TryStrToFloat(RelEdit.Text, x) then
begin
AControl := RelEdit;
AMsg := 'Numeric input expected for test reliability.';
exit;
end;
Result := true;
end;
initialization
{$I testgenunit.lrs}