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

applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.lfm

@@ -18,99 +18,85 @@ object TestGenFrm: TTestGenFrm
     AnchorSideLeft.Side = asrCenter
     AnchorSideTop.Control = Panel1
     AnchorSideTop.Side = asrBottom
-    Left = 63
+    Left = 57
-    Height = 70
+    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
+    ClientHeight = 52
-    ClientWidth = 206
+    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
+    AnchorSideRight.Control = ComputeBtn
-    Left = 31
+    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
+    AnchorSideRight.Control = CloseBtn
-    Left = 171
+    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
+    Top = 239
-    Width = 61
+    Width = 55
     Anchors = [akTop, akRight]
     AutoSize = True
+    BorderSpacing.Left = 8
     BorderSpacing.Top = 8
-    BorderSpacing.Right = 16
+    BorderSpacing.Right = 8
     BorderSpacing.Bottom = 8
-    Caption = 'Return'
+    Caption = 'Close'
-    ModalResult = 1
+    ModalResult = 11
-    TabOrder = 5
+    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.Left = 16
-    BorderSpacing.Right = 12
+    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

applications/lazstats/source/forms/analysis/measurement_programs/testgenunit.pas

@@ -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.');
+        res := MessageDlg('You must first close the current file. Close it now?', mtConfirmation, [mbYes, mbNo], 0);
-        exit;
+        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 -
+    total_item_var := (test_var / no_items) * (1.0 - ((no_items - 1) / no_items) * reliability);
-        ((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])
+            if (itemtype = 0) then
-            else outline := format('%6.4f',[X]);
+              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}