LazStats: Extract computation code from TCrossTabFrm to separate calculation class.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7709 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/lazstats/source/forms/analysis/descriptive/crosstabunit.lfm

@@ -134,6 +134,7 @@ inherited CrossTabFrm: TCrossTabFrm
       BorderSpacing.Right = 8
       ItemHeight = 0
       MultiSelect = True
+      OnDblClick = VarListDblClick
       OnSelectionChange = VarListSelectionChange
       TabOrder = 4
     end
@@ -154,6 +155,7 @@ inherited CrossTabFrm: TCrossTabFrm
       BorderSpacing.Top = 2
       ItemHeight = 0
       MultiSelect = True
+      OnDblClick = SelListDblClick
       OnSelectionChange = VarListSelectionChange
       TabOrder = 5
     end

applications/lazstats/source/forms/analysis/descriptive/crosstabunit.pas

@@ -34,34 +34,27 @@ type
     VarList: TListBox;
     SelList: TListBox;
     procedure CloseBtnClick(Sender: TObject);
+    procedure ComputeBtnClick(Sender: TObject);
     procedure FormActivate(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure HelpBtnClick(Sender: TObject);
     procedure InBtnClick(Sender: TObject);
-    procedure ComputeBtnClick(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);
   private
     { private declarations }
     FReportFrame: TReportFrame;
-    FAutoSized: Boolean;
+    FAutosized: Boolean;
-    grandsum, sum, index : integer;
-    no_in_list, length_array, ptr1, ptr2 : integer ;
-    var_list, min_value, max_value, levels, displace, subscript : IntDyneVec;
-    freq : IntDyneVec;
-    outgrid : DblDyneMat;
-    rowlabels : StrDyneVec;
-    colLabels : StrDyneVec;
-    ColNoSelected : IntDyneVec;
-    NoSelected : integer;
-    NV, NC : integer;
 
-    procedure Initialize;
+//    procedure Initialize;
-    procedure GetLevels(AReport: TStrings);
+//    procedure GetLevels(AReport: TStrings);
-    function IndexPosition(x: IntDyneVec): integer;
+//    function IndexPosition(x: IntDyneVec): integer;
-    Procedure Tabulate;
+//    Procedure Tabulate;
-    procedure BreakDown(AReport: TStrings);
+//    procedure BreakDown(AReport: TStrings);
+    procedure Prepare(out AVarList, AColNoSelected: IntDyneVec);
     procedure UpdateBtnStates;
 
   public
@@ -78,12 +71,312 @@ implementation
 {$R *.lfm}
 
 uses
-  Math,
+  Math, Grids,
-  Utils;
+  Utils, DictionaryUnit;
+
+{ TCrossTabCalculator }
+
+type
+  TCrossTabCalculator = class
+  private
+    FReport: TStrings;
+    FVarList: IntDyneVec;
+    FDataGrid: TStringGrid;
+    FColNoSelected: IntDyneVec;
+
+    grandsum, sum, index: integer;
+    no_in_list, length_array: integer;
+    min_value, levels, displace, subscript: IntDyneVec;
+    freq: IntDyneVec;
+    outgrid: DblDyneMat;
+    NoSelected: integer;
+
+  protected
+    procedure BreakDown;
+    procedure GetLevels;
+    function IndexPosition(x: IntDyneVec): integer;
+    procedure Tabulate;
+
+    function GoodRecord(Row, NoVars: integer; const GridPos: IntDyneVec): boolean;
+    function IsFiltered(GridRow: integer): boolean;
+    function ValidValue(row, col: integer): boolean;
+
+  public
+    procedure Execute(AReport: TStrings; ADataGrid: TStringGrid;
+      AVarList, AColNoSelected: IntDyneVec);
+
+  end;
+
+
+procedure TCrossTabCalculator.BreakDown;
+label
+  1,2,3,4, printgrid;
+var
+  i, j, row, col, bigmax: integer;
+  ptr1, ptr2: Integer;
+  outline: string;
+  value: string;
+  title: String;
+  rowLabels: StrDyneVec = nil;
+  colLabels: StrDyneVec = nil;
+begin
+  bigmax := -1;
+  for i := 0 to no_in_list-1 do
+    if Levels[i] > bigmax then bigmax := Levels[i];
+
+  SetLength(colLabels, bigmax);
+  SetLength(outgrid, length_array, bigmax);
+  SetLength(rowlabels, length_array);
+
+  outline := FDataGrid.Cells[FVarList[no_in_list-1], 0];
+  for col := 1 to Levels[no_in_list-1] do
+    collabels[col-1] := outline + Format(':%3d', [min_value[no_in_list-1] + col - 1]);
+
+  for row := 1 to length_array do
+    rowlabels[row-1] := '';
+
+  ptr1 := no_in_list - 1;
+  ptr2 := no_in_list;
+  for i := 1 to no_in_list do
+    subscript[i-1] := 1;
+
+  FReport.Add('');
+  FReport.Add('FREQUENCIES BY LEVEL:');
+  FReport.Add('');
+
+  sum := 0;
+  col := 1;
+  row := 1;
+
+ 1:
+   index := IndexPosition(subscript);
+   outline := 'For cell levels: ';
+   for i := 1 to no_in_list do
+   begin
+     j := FVarList[i-1];
+     value := Format('%s:%3d  ',[FDataGrid.Cells[j,0], min_value[i-1] + subscript[i-1] - 1]);
+     outline := outline + value;
+   end;
+   sum := sum + freq[index];
+   outgrid[row-1,col-1] := freq[index];
+   outline := outline + Format(' Frequency: %3d', [freq[index]]);
+   FReport.Add(outline);
+
+   subscript[ptr2-1] := subscript[ptr2-1] + 1;
+   col := col + 1;
+   if subscript[ptr2-1] <= levels[ptr2-1] then
+     goto 1;
+
+   FReport.Add('Sum across levels: %3d', [sum]);
+   FReport.Add('');
+
+   grandsum := grandsum + sum;
+   sum := 0;
+   row := row + 1;
+
+ 2:
+   if ptr1 < 1 then
+     goto printgrid;
+
+   subscript[ptr1-1] := subscript[ptr1-1] + 1;
+   if subscript[ptr1-1] <= levels[ptr1-1] then
+     goto 4;
+
+ 3:
+   ptr1 := ptr1 - 1;
+   if ptr1 < 1 then
+     goto printgrid;
+   if subscript[ptr1-1] >= levels[ptr1-1] then
+     goto 3;
+   subscript[ptr1-1] := subscript[ptr1-1] + 1;
+
+ 4:
+   for i := ptr1 + 1 to no_in_list do
+     subscript[i-1] := 1;
+   ptr1 := no_in_list - 1;
+   col := 1;
+
+   goto 1;
+
+printgrid:
+  title := 'CELL FREQUENCIES BY LEVELS';
+  for i := 1 to row - 1 do
+  begin
+    value := Format('Block %d',[i]);
+    rowlabels[i-1] := value;
+  end;
+
+  FReport.Add('');
+  MatPrint(outgrid, row-1, Levels[no_in_list-1], title, rowlabels, collabels, NoCases, FReport);
+end;
+
+
+procedure TCrossTabCalculator.Execute(AReport: TStrings; ADataGrid: TStringGrid;
+  AVarList, AColNoSelected: IntDyneVec);
+begin
+  FReport := AReport;
+  FDataGrid := ADataGrid;
+  FVarList := AVarList;
+
+  no_in_list := Length(FVarList);
+  SetLength(min_value, no_in_list);
+  SetLength(levels, no_in_list);
+  SetLength(displace, no_in_list);
+  SetLength(subscript, no_in_list);
+
+  FColNoSelected := AColNoSelected;
+  NoSelected := Length(FColNoSelected);
+
+  GetLevels;
+  Tabulate;
+  BreakDown;
+
+  FReport.Add('');
+  FReport.Add('Grand sum across all categories: %d', [grandsum]);
+end;
+
+procedure TCrossTabCalculator.GetLevels;
+var
+  i, j, k: integer;
+  value: double;
+  max_value: IntDyneVec = nil;
+begin
+  SetLength(max_value, no_in_list);
+  for i := 1 to no_in_list do
+  begin
+    j := FVarList[i-1];
+    if not GoodRecord(1, NoSelected, FColNoSelected) then continue;
+    value := StrToFloat(FDataGrid.Cells[j, 1]);
+    min_value[i-1] := round(value);
+    max_value[i-1] := round(value);
+    for k := 2 to NoCases do
+    begin
+      if not GoodRecord(k, NoSelected, FColNoSelected) then continue;
+      value := StrToFloat(FDataGrid.Cells[j, k]);
+      if value < min_value[i-1] then
+        min_value[i-1] := round(value);
+      if value > max_value[i-1] then
+        max_value[i-1] := round(value);
+    end;
+  end;
+
+  for i := 1 to no_in_list do
+  begin
+    j := FVarList[i-1];
+    levels[i-1] := max_value[i-1] - min_value[i-1] + 1;
+    FReport.Add('%-10s   min %3d, max %3d, number of levels %3d', [
+      FDataGrid.Cells[j,0]+':', min_value[i-1], max_value[i-1], levels[i-1]
+    ]);
+  end;
+  FReport.Add('');
+
+  displace[no_in_list-1] := 1;
+  if no_in_list > 1 then
+    for i := (no_in_list - 1) downto 1 do
+      displace[i-1] := levels[i] * displace[i];
+end;
+
+
+function TCrossTabCalculator.GoodRecord(Row, NoVars: integer;
+  const GridPos: IntDyneVec): boolean;
+var
+  i, j: integer;
+begin
+  Result := true;
+  for i := 0 to NoVars-1 do
+  begin
+    j := GridPos[i];
+    if not ValidValue(Row, j) then
+      Result := false;
+  end;
+end;
+
+
+function TCrossTabCalculator.IndexPosition(x: IntDyneVec): integer;
+var
+  i: integer;
+begin
+  Result := x[no_in_list-1];
+  if no_in_list > 1 then
+  begin
+    for i := 1 to no_in_list - 1 do
+      Result := Result + (x[i-1] -1) * displace[i-1];
+  end;
+end;
+
+
+function TCrossTabCalculator.IsFiltered(GridRow: integer): boolean;
+begin
+  Result := FilterOn and (Trim(FDataGrid.Cells[FilterCol,GridRow]) = 'NO');
+end;
+
+
+procedure TCrossTabCalculator.Tabulate;
+var
+  i, j, k: integer;
+  value: double;
+  x: integer;
+begin
+  length_array := 1;
+  for i := 1 to no_in_list do
+    length_array := length_array * levels[i-1];
+  SetLength(freq, length_array+1);
+
+  for i := 0 to length_array do
+    freq[i] := 0;
+  for i := 1 to NoCases do
+  begin
+    if IsFiltered(i) then
+      continue;
+    for j := 1 to no_in_list do
+    begin
+      if not GoodRecord(i, NoSelected, FColNoSelected) then continue;
+      k := FVarList[j-1];
+      value := StrToFloat(FDataGrid.Cells[k,i]);
+      x := round(value);
+      x := x - min_value[j-1] + 1;
+      subscript[j-1] := x;
+    end;
+    j := IndexPosition(subscript);
+
+    if (j < 1) or (j > length_array) then
+      continue
+    else
+      freq[j] := freq[j] + 1;
+  end;
+end;
+
+
+function TCrossTabCalculator.ValidValue(row, col: integer): boolean;
+var
+  valid: boolean;
+  xvalue: string;
+  cellstring: string;
+begin
+  valid := true;
+  if FilterOn then
+  begin
+    cellstring := Trim(FDataGrid.Cells[FilterCol, row]);
+    if cellstring = 'NO' then valid := false;
+    Result := valid;
+    exit;
+  end;
+
+  xvalue := Trim(FDataGrid.Cells[col, row]);
+  if (xvalue = '') and (DictionaryFrm.DictGrid.Cells[4, col] <> 'S') then
+    valid := false;
+  if valid then  // check for user-defined missing value
+  begin
+    if Trim(DictionaryFrm.DictGrid.Cells[6, col]) = xvalue then
+      valid := false;
+  end;
+  Result := valid;
+end;
+
 
 
 { TCrossTabFrm }
-
+                (*
 procedure TCrossTabFrm.BreakDown(AReport: TStrings);
 label 1,2,3,4, printgrid;
 var
@@ -175,7 +468,7 @@ printgrid:
 
   MatPrint(outgrid,row-1,Levels[no_in_list-1],title,rowlabels,collabels,NC, AReport);
 end; { Procedure BREAKDOWN }
-
+                       *)
 
 procedure TCrossTabFrm.CloseBtnClick(Sender: TObject);
 begin
@@ -185,24 +478,17 @@ end;
 
 procedure TCrossTabFrm.ComputeBtnClick(Sender: TObject);
 var
-  cellvalue: string;
+  lReport: TStringList;
-  i, j: integer;
+  calculator: TCrossTabCalculator;
-  lReport: TStrings;
+  var_list: IntDyneVec = nil;
+  colNoSelected: IntDyneVec = nil;
 begin
   if SelList.Items.Count = 0 then
   begin
-    MessageDlg('No variables selected for analysis.', mtError, [mbOK], 0);
+    ErrorMsg('No variables selected for analysis.');
     exit;
   end;
 
-  SetLength(var_list, NV);
-  SetLength(min_value, NV);
-  SetLength(max_value, NV);
-  SetLength(levels, NC);
-  SetLength(displace, NC);
-  SetLength(subscript,NC);
-  SetLength(ColNoSelected, NV);
-
   lReport := TStringList.Create;
   try
     lReport.Add('CROSSTAB RESULTS');
@@ -210,34 +496,14 @@ begin
     lReport.Add('Analyzed data is from file ' + OS3MainFrm.FileNameEdit.Text);
     lReport.Add('');
 
-    Initialize;
+    calculator := TCrossTabCalculator.Create;
-
+    try
-    NoSelected := 0;
+      Prepare(var_list, colNoSelected);
-    for i := 0 to SelList.Items.Count-1 do
+      calculator.Execute(lReport, OS3MainFrm.DataGrid, var_list, colNoSelected);
-    begin
+      FReportFrame.DisplayReport(lReport);
-      for j := 1 to NV do
+    finally
-      begin
+      calculator.Free;
-        cellvalue := OS3MainFrm.DataGrid.Cells[j,0];
-        if cellvalue = SelList.Items[i] then
-        begin
-          var_list[i] := j;
-          ColNoSelected[i] := j;
-          NoSelected := NoSelected + 1;
-          break;
-        end;
-      end;
     end;
-
-    no_in_list := SelList.Items.Count;
-    GetLevels(lReport);
-    Tabulate;
-    BreakDown(lReport);
-
-    lReport.Add('');
-    lReport.Add('Grand sum across all categories = %d', [grandsum]);
-
-    FReportFrame.DisplayReport(lReport);
-
   finally
     lReport.Free;
   end;
@@ -277,7 +543,6 @@ procedure TCrossTabFrm.FormCreate(Sender: TObject);
 begin
   Assert(OS3MainFrm <> nil);
 
-
   InitForm(self);
 
   FReportFrame := TReportFrame.Create(self);
@@ -291,46 +556,6 @@ begin
 end;
 
 
-procedure TCrossTabFrm.GetLevels(AReport: TStrings);
-var
-  i, j, k: integer;
-  value: double;
-begin
-  for i := 1 to no_in_list do
-  begin
-    j := var_list[i-1];
-    if not GoodRecord(1,NoSelected,ColNoSelected) then continue;
-    value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,1]);
-    min_value[i-1] := round(value);
-    max_value[i-1] := round(value);
-    for k := 2 to NC do
-    begin
-      if not GoodRecord(k,NoSelected,ColNoSelected) then continue;
-      value := StrToFloat(OS3MainFrm.DataGrid.Cells[j,k]);
-      if value < min_value[i-1] then
-        min_value[i-1] := round(value);
-      if value > max_value[i-1] then
-        max_value[i-1] := round(value);
-    end;
-  end;
-
-  for i := 1 to no_in_list do
-  begin
-    j := var_list[i-1];
-    levels[i-1] := max_value[i-1] - min_value[i-1] + 1;
-    AReport.Add('%s min.=%3d, max.=%3d, no. levels = %3d', [
-      OS3MainFrm.DataGrid.Cells[j,0],min_value[i-1],max_value[i-1],levels[i-1]
-    ]);
-  end;
-  AReport.Add('');
-
-  displace[no_in_list-1] := 1;
-  if no_in_list > 1 then
-    for i := (no_in_list - 1) downto 1 do
-      displace[i-1] := levels[i] * displace[i];
-end;
-
-
 procedure TCrossTabFrm.HelpBtnClick(Sender: TObject);
 begin
   if ContextHelpForm = nil then
@@ -358,39 +583,6 @@ begin
 end;
 
 
-function TCrossTabFrm.IndexPosition(x: IntDyneVec): integer;
-var
-  i: integer;
-begin
-  Result := x[no_in_list-1];
-  if no_in_list > 1 then
-  begin
-    for i := 1 to no_in_list - 1 do
-      Result := Result + (x[i-1] -1) * displace[i-1];
-  end;
-end;
-
-
-procedure TCrossTabFrm.Initialize;
-var
-  i: integer;
-begin
-  no_in_list := 0;
-  for i := 1 to NV do
-  begin
-    var_list[i-1] := 0;
-    min_value[i-1] := 0;
-    max_value[i-1] := 0;
-    levels[i-1] := 0;
-    displace[i-1] := 0;
-    subscript[i-1] := 0;
-  end;
-  index := 0;
-  length_array := 0;
-  grandsum := 0;
-end;
-
-
 procedure TCrossTabFrm.OutBtnClick(Sender: TObject);
 var
   i: integer;
@@ -410,15 +602,43 @@ begin
 end;
 
 
+procedure TCrossTabFrm.Prepare(out AVarlist, AColNoSelected: IntDyneVec);
+var
+  i, j: Integer;
+  noSelected: Integer;
+  cellValue: String;
+begin
+  SetLength(AVarList, SelList.Count);
+  SetLength(AColNoSelected, SelList.Count);
+
+  noSelected := 0;
+  for i := 0 to SelList.Items.Count-1 do
+  begin
+    for j := 1 to NoVariables do
+    begin
+      cellvalue := OS3MainFrm.DataGrid.Cells[j, 0];
+      if cellvalue = SelList.Items[i] then
+      begin
+        AVarList[i] := j;
+        AColNoSelected[i] := j;
+        inc(noSelected);
+        break;
+      end;
+    end;
+  end;
+
+  SetLength(AVarList, noSelected);
+  Setlength(AColNoSelected, noSelected);
+end;
+
+
 procedure TCrossTabFrm.Reset;
 var
   i: integer;
 begin
   VarList.Clear;
   SelList.Clear;
-  NV := NoVariables;
+  for i := 1 to NoVariables do
-  NC := NoCases;
-  for i := 1 to NV do
     VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
   UpdateBtnStates;
   FReportFrame.Clear;
@@ -431,40 +651,18 @@ begin
 end;
 
 
-procedure TCrossTabFrm.Tabulate;
+procedure TCrossTabFrm.SelListDblClick(Sender: TObject);
 var
-  i, j, k: integer;
+  index: Integer;
-  value: double;
-  x: integer;
 begin
-  length_array := 1;
+  index := SelList.ItemIndex;
-  for i := 1 to no_in_list do
+  if index > -1 then
-    length_array := length_array * levels[i-1];
-  SetLength(freq,length_array+1);
-
-  for i := 0 to length_array do
-    freq[i] := 0;
-  for i := 1 to NC do
   begin
-    if IsFiltered(i) then
+    VarList.Items.Add(Sellist.Items[index]);
-      continue;
+    SelList.Items.Delete(index);
-    for j := 1 to no_in_list do
+    UpdateBtnStates;
-    begin
-      if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
-      k := var_list[j-1];
-      value := StrToFloat(OS3MainFrm.DataGrid.Cells[k,i]);
-      x := round(value);
-      x := x - min_value[j-1] + 1;
-      subscript[j-1] := x;
-    end;
-    j := IndexPosition(subscript);
-
-    if (j < 1) or (j > length_array) then
-      continue
-    else
-      freq[j] := freq[j] + 1;
   end;
-end; { procedure TABULATE }
+end;
 
 
 procedure TCrossTabFrm.UpdateBtnStates;
@@ -494,6 +692,20 @@ begin
 end;
 
 
+procedure TCrossTabFrm.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 TCrossTabFrm.VarListSelectionChange(Sender: TObject; User: boolean);
 begin
   UpdateBtnStates;

applications/lazstats/source/units/dataprocs.pas

@@ -913,39 +913,6 @@ begin
   SaveSeparatorFile(' ', SSV_FILE_FILTER, 'ssv');
 end;
 
-{
-procedure SaveTabFile;
-var
-  namestr: string;
-  cellvalue: string;
-  TabFile: TextFile;
-  i, j: integer;
-begin
-  OS3MainFrm.SaveDialog1.Filter := TAB_FILE_FILTER;
-  OS3MainFrm.SaveDialog1.FilterIndex := 1;
-  OS3MainFrm.SaveDialog1.DefaultExt := 'tab';
-  if OS3MainFrm.SaveDialog1.Execute then
-  begin
-    namestr := OS3MainFrm.SaveDialog1.FileName;
-    Assign(TabFile,namestr);
-    ReWrite(TabFile);
-    for i := 0 to NoCases do                       // wp: why not NoCases-1 ?
-    begin
-      for j := 1 to NoVariables do   //write all but last with a tab
-      begin
-        cellvalue := OS3MainFrm.DataGrid.Cells[j,i];
-        if cellvalue = '' then cellvalue := '.';   // wp: why not "missing value"?
-        cellvalue := Trim(cellvalue);              // wp: why not before prev line?
-        if j < NoVariables then cellvalue := cellvalue + #9;
-        write(TabFile,cellvalue);
-      end;
-      writeln(TabFile);
-    end;
-  end;
-  CloseFile(TabFile);
-end;
-}
-
 function ValidValue(row, col: integer): boolean;
 var
   valid: boolean;