lazarus-ccr/applications/lazstats/source/forms/analysis/descriptive/frequnit.pas

// Use "cansas.laz" for testing.

unit FreqUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, Spin,
  Globals, MainUnit, FunctionsLib, GraphLib, DataProcs, ReportFrameUnit, ChartFrameUnit;

type

  { TFreqFrm }

  TFreqFrm = class(TForm)
    Bevel1: TBevel;
    ComputeBtn: TButton;
    NoIntervalsLabel: TLabel;
    PageControl: TPageControl;
    Panel1: TPanel;
    Panel2: TPanel;
    ParamsPanel: TPanel;
    ResetBtn: TButton;
    CloseBtn: TButton;
    NormPltChk: TCheckBox;
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    SelList: TListBox;
    PlotOptionsGroup: TRadioGroup;
    BarTypeGroup: TRadioGroup;
    ParamsSplitter: TSplitter;
    ReportPage: TTabSheet;
    NoIntervalsEdit: TSpinEdit;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
    procedure ComputeBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure PlotOptionsGroupSelectionChanged(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure SelListSelectionChange(Sender: TObject; User: boolean);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; User: boolean);
  private
    { private declarations }
    FReportFrame: TReportFrame;
    FAutoSized: Boolean;
    procedure ClearTabs;
    function CreateChartFrame(AColIndex: Integer; AVarName: String): TChartFrame;
    function GetPageCaption(AVarName: String): String;
    procedure PlotFreq(AColIndex: Integer; AVarName: String; const xLabels: StrDyneVec;
      const Freq: DblDyneVec);
    procedure UpdateBtnStates;
  public
    { public declarations }
    procedure Reset;
  end; 

var
  FreqFrm: TFreqFrm;


implementation

{$R *.lfm}

uses
  Math, TAChartUtils, TALegend, TASeries,
  Utils, FreqSpecsUnit;

{ TFreqFrm }

procedure TFreqFrm.AllBtnClick(Sender: TObject);
var
  count, index : integer;
begin
  count := VarList.Items.Count;
  for index := 0 to count-1 do
    SelList.Items.Add(VarList.Items[index]);
  VarList.Clear;
  ClearTabs;
  UpdateBtnStates;
end;


procedure TFreqFrm.ClearTabs;
var
  i: Integer;
begin
  FReportFrame.Clear;
  for i := PageControl.PageCount-1 downto 1 do
    PageControl.Pages[i].Free;
end;


procedure TFreqFrm.CloseBtnClick(Sender: TObject);
begin
  Close;
end;


procedure TFreqFrm.ComputeBtnClick(Sender: TObject);
var
  i, j, k: integer;
  freq: DblDyneVec = nil;
  pcnt: DblDyneVec = nil;
  cumpcnt: DblDyneVec = nil;
  pcntilerank: DblDyneVec = nil;
  cumfreq: DblDyneVec = nil;
  XLabels: StrDyneVec = nil;
  XValue: DblDyneVec = nil;
  value: double;
  NoVars: integer;
  plottype: integer;
  cellval: string;
  col: integer;
  min, max, range: double;
  incrsize: double;
  nointervals: double;
  nInts: integer;
  NormDist: boolean;
  Sumx, Sumx2, Mean, Variance, StdDev, zlow, zhi: double;
  X, zproplow, zprophi, zfreq: double;
  nCases: integer;
  oldPageIndex: Integer;
  found: Boolean;
  lReport: TStrings;
begin
  if SelList.Count = 0 then
  begin
    ErrorMsg('No variable(s) selected.');
    exit;
  end;

  NormDist := NormPltChk.Checked;

  SetLength(freq, NoCases);
  SetLength(pcnt, NoCases);
  SetLength(cumpcnt, NoCases);
  SetLength(pcntilerank, NoCases);
  SetLength(cumfreq, NoCases);
  SetLength(XValue, NoCases);

  (*    ---------------> causes flicker
  // Remove already existing chart pages
  oldPageIndex := PageControl.PageIndex;
  for i := PageControl.PageCount-1 downto 1 do
    PageControl.Pages[i].Free;
  *)

  lReport := TStringList.Create;
  try
    lReport.Add('FREQUENCY ANALYSIS BY BILL MILLER');
    lReport.Add('');

    { Analyze each variable }
    NoVars := SelList.Items.Count;
    for i := 1 to NoVars do
    begin
      { get column no. of variable }
      col := 1;
      cellval := SelList.Items[i-1];
      for j := 1 to NoVariables do
      begin
        if OS3MainFrm.DataGrid.Cells[j,0] = cellval then
        begin
          col := j;
          if i > 1 then lReport.Add('');
          lReport.Add('Frequency analysis for variable "%s"', [cellval]);
          break;
        end;
      end;

      { get min and max values for variable in col }
      min := Infinity;
      max := -Infinity;
      for j := 1 to NoCases do
      begin
        if not ValidValue(j, col) then continue;
        value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]);
        if value > max then max := value;
        if value < min then min := value;
      end;
      (*
      range := max - min + 1.0;
      incrsize := 1.0;
      { if too many increments, set increment size for 15 increments }
      if range > 200.0 then incrsize := range / 15;
      nointervals := range / incrsize;
      nints := round(nointervals);

      { Get user's approval and / or changes }
      FreqSpecsFrm.VarName.Text := cellval;
      FreqSpecsFrm.Minimum.Text := FloatToStr(min);
      FreqSpecsFrm.Maximum.Text := FloatToStr(max);
      FreqSpecsFrm.range.Text := FloatToStr(range);
      FreqSpecsFrm.IntSize.Text := FloatToStr(incrsize);
      FreqSpecsFrm.NoInts.Text := IntToStr(nints);
      FreqSpecsFrm.NoCases := NoCases;
      if FreqSpecsFrm.ShowModal <> mrOK then
        exit;

      incrsize := StrToFloat(FreqSpecsFrm.IntSize.Text);
      nints := StrToInt(FreqSpecsFrm.NoInts.Text);
      if nints > 200 then
        nints := 200;
      *)

      nInts := NoIntervalsEdit.Value;
      incrSize := (max - min) / nInts;

      SetLength(freq, nInts);
      SetLength(XValue, nInts);
      SetLength(XLabels, nInts);

      { Get frequency of cases in each interval }
      nCases := 0;
      for j := 1 to NoCases do
      begin
        if not ValidValue(j, col) then continue;
        inc(nCases);
        value := StrToFloat(OS3MainFrm.DataGrid.Cells[col, j]);
        for k := 0 to nints-1 do
          if (value >= min + k * incrSize) and (value < min + ((k+1) * incrSize)) then
            freq[k] := freq[k] + 1.0;
      end;
      for j := 0 to nInts-1 do
      begin
        XValue[j] := min + j * incrSize;
        XLabels[j] := Format('%.2f'+LineEnding+'to'+LineEnding+'%.2f', [XValue[j], XValue[j] + incrSize]);
      end;

      { Get cumulative frequencies and percents to midpoints }
      cumFreq[0] := freq[0];
      pcnt[0] := freq[0] / nCases;
      cumPcnt[0] := cumFreq[0] / nCases;
      pcntileRank[0] := (freq[0] * 0.5)  / nCases;
      for k := 1 to nInts - 1do
      begin
        cumfreq[k] := cumfreq[k-1] + freq[k];
        pcnt[k] := freq[k] / nCases;
        cumPcnt[k] := cumFreq[k] / nCases;
        pcntileRank[k] := (cumFreq[k-1] + freq[k] * 0.5) / nCases;
      end;

      { Print results to report }
      lReport.Add('    FROM    TO      FREQ.   PCNT    CUM.FREQ. CUM.PCNT. %ILE RANK');
      lReport.Add('');
      for k := 0 to nInts - 1 do
        lReport.Add('%8.2f%8.2f%8.0f%8.2f  %8.2f  %8.2f  %8.2f', [
          min + k*incrSize,      // from
          min + (k+1)*incrSize,  // to
          freq[k],               // freq
          pcnt[k],               // pcnt
          cumFreq[k],            // cum.freq.
          cumPcnt[k],            // cum.pcnt.
          pcntileRank[k]         // %ile rank
        ]);
                               (*
      { Now, prepare plot values as indicated in options list }
      if NormDist = false then
        SetLength(GraphFrm.Ypoints,1,nints+1)
      else
        SetLength(GraphFrm.Ypoints,2,nints+1);
      SetLength(GraphFrm.Xpoints,1,nints+1);
      for k := 1 to nints+1 do
      begin
        GraphFrm.Ypoints[0,k-1] := freq[k-1];
        GraphFrm.Xpoints[0,k-1] := XValue[k-1];
      end;                       *)

      // Create ND plot if checked.
      // BUT: Only 3D-vertical plots when normal curve is desired
      if NormDist then
      begin
        lReport.Add('');
        lReport.Add('Interval ND Freq.');
        // Only use 3Dvertical plots when normal curve desired
        PlotOptionsGroup.ItemIndex := 1;
        // get mean and standard deviation of xvalues, then height of
        // the normal curve for each Normally distributed corresponding z score
        sumx := 0.0;
        sumx2 := 0.0;
        for k := 1 to nints do
        begin
          sumx := sumx + (XValue[k-1] * freq[k-1]);
          sumx2 := sumx2 + ((XValue[k-1] * XValue[k-1]) * freq[k-1]);
        end;
        Mean := sumx / Ncases;
        Variance := sumx2 - ((sumx * sumx) / Ncases);
        Variance := Variance / (Ncases - 1);
        StdDev := sqrt(Variance);
        for k := 1 to nints+1 do
        begin
          X := XValue[k-1] - (incrsize / 2.0);
          if StdDev > 0.0 then
            zlow := (X - Mean) / StdDev
          else
            zlow := 0.0;
          X := XValue[k-1] + (incrsize / 2.0);
          if StdDev > 0.0 then
            zhi := (X - Mean) / StdDev
          else
            zhi := 0.0;

          // get cum. prop. for this z and translate to frequency
          zproplow := probz(zlow);
          zprophi := probz(zhi);
          zfreq := NoCases * abs(zprophi - zproplow);
          (*  !!!!!!!!!!!!!!!!!!!
          GraphFrm.Ypoints[1,k-1] := zfreq;
          lReport.Add('    %2d      %6.2f', [k, GraphFrm.Ypoints[1,k-1]]);
          *)
        end;
      end;

      // Show report in form
      FReportFrame.DisplayReport(lReport);

      // Plot data
      PlotFreq(col, cellVal, xLabels, freq);
    end;
  (*
      plottype := PlotOptionsGroup.ItemIndex + 1;
      if Histogram then
        GraphFrm.barwideprop := 1.0
      else
        GraphFrm.barwideprop := 0.5;
      if NormDist then
        GraphFrm.nosets := 2
      else
        GraphFrm.nosets := 1;
      GraphFrm.nbars := nints+1;
      GraphFrm.Heading := cellval;
      GraphFrm.XTitle := 'Lower Limit Values';
      GraphFrm.YTitle := 'Frequency';
      GraphFrm.AutoScaled := true;
      GraphFrm.GraphType := plotType;
      GraphFrm.BackColor := clCream;
      GraphFrm.WallColor := clDkGray;
      GraphFrm.FloorColor := clLtGray;
      GraphFrm.ShowBackWall := true;
      if plotType in [2, 6, 8, 10] then
      begin
        GraphFrm.ShowLeftWall := true;
        GraphFrm.ShowRightWall := true;
        GraphFrm.ShowBottomWall := true;
      end;
      GraphFrm.ShowModal;
      GraphFrm.Xpoints := nil;
      GraphFrm.Ypoints := nil;
    end; // for novars list
    *)
  {
    for j := PageControl.PageCount-1 downto 1 do
    begin
      found := false;
      for i := 0 to SelList.Count-1 do
        if GetPageCaption(SelList.Items[i]) = PageControl.Pages[j].Caption then
        begin
          found := true;
          break;
        end;
      if not found then
        PageControl.Pages[j].Free;
    end;
   }
  finally
    lReport.Free;
    (*
    XValue := nil;
    cumfreq := nil;
    pcntilerank := nil;
    cumpcnt := nil;
    pcnt := nil;
    freq := nil;
    *)
  end;
end;


function TFreqFrm.CreateChartFrame(AColIndex: Integer; AVarName: String): TChartFrame;
var
  sheetTitle: String;
  tabSheet: TTabSheet;
  i: Integer;
begin
  sheetTitle := GetPageCaption(AVarName);

  // Find existing sheet first.
  for i := 1 to PageControl.PageCount-1 do
    if PageControl.Pages[i].Caption = sheetTitle then begin
      tabSheet := PageControl.Pages[i];
      Result := tabSheet.Controls[0] as TChartFrame;
      exit;
    end;

  // Not found: create new sheet ...
  tabSheet := PageControl.AddTabSheet;
  tabSheet.Caption := sheetTitle;
  tabSheet.Tag := AColIndex;

  // ... and add ChartFrame
  Result := TChartFrame.Create(tabSheet);
  Result.Parent := tabSheet;
  Result.Align := alClient;
  Result.Chart.Legend.Alignment := laBottomCenter;
  Result.Chart.Legend.ColumnCount := 3;
  Result.Chart.Legend.TextFormat := tfHTML;
  Result.Chart.BottomAxis.Intervals.MaxLength := 80;
  Result.Chart.BottomAxis.Intervals.MinLength := 30;
end;


procedure TFreqFrm.FormActivate(Sender: TObject);
var
  w: Integer;
begin
  if FAutoSized then
    exit;

  w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
  ResetBtn.Constraints.MinWidth := w;
  ComputeBtn.Constraints.MinWidth := w;
  CloseBtn.Constraints.MinWidth := w;

  (*
  Panel1.Constraints.MinHeight := BarTypeGroup.Top + BarTypeGroup.Height - Panel1.Top;
  Panel1.Constraints.MinWidth := Label2.Width * 2 + AllBtn.Width + 2 * VarList.BorderSpacing.Right;
  Constraints.MinWidth := Width;
  Constraints.MinHeight := Height;
  *)

  Position := poMainFormCenter;
  FAutoSized := true;
end;


procedure TFreqFrm.FormCreate(Sender: TObject);
begin
  Assert(OS3MainFrm <> nil);

  if FreqSpecsFrm = nil then
    Application.CreateForm(TFreqSpecsFrm, FreqSpecsFrm);

  if GraphFrm = nil then
    Application.CreateForm(TGraphFrm, GraphFrm);

  InitForm(Self);

  FReportFrame := TReportFrame.Create(self);
  FReportFrame.Parent := ReportPage;
  FReportFrame.Align := alClient;

  Reset;
end;


function TFreqFrm.GetPageCaption(AVarName: String): String;
begin
  Result := 'Plot of ' + AVarName;
end;


procedure TFreqFrm.InBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < VarList.Items.Count do
  begin
    if (VarList.Selected[i]) then
    begin
      SelList.Items.Add(VarList.Items[i]);
      VarList.Items.Delete(i);
      i := 0;
    end else
      i := i + 1;
  end;
  ClearTabs;
  UpdateBtnStates;
end;


procedure TFreqFrm.SelListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;

procedure TFreqFrm.OutBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := 0;
  while i < SelList.Items.Count do
  begin
    if (SelList.Selected[i]) then
    begin
      VarList.Items.Add(SelList.Items[i]);
      SelList.Items.Delete(i);
      i := 0;
    end else
      inc(i);
  end;
  ClearTabs;
  UpdateBtnStates;
end;


procedure TFreqFrm.PlotFreq(AColIndex: Integer; AVarName: String;
  const xLabels: StrDyneVec; const Freq: DblDyneVec);
var
  ser: TBarSeries;
  chartFrame: TChartFrame;
begin
  chartFrame := CreateChartFrame(AColIndex, AVarName);
  chartFrame.Clear;

  ser := chartFrame.PlotXY(ptVertBars, nil, Freq, xLabels, nil, '', clDefault) as TBarSeries;
  ser.BarBrush.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)];
  if BarTypeGroup.ItemIndex = 1 then
  begin
    ser.BarWidthPercent := 100;
    ser.BarPen.Color := ser.BarBrush.Color;
  end;

  chartFrame.Chart.Margins.Bottom := 0;
  chartFrame.Chart.BottomAxis.Marks.Source := ser.Source;
  chartFrame.Chart.BottomAxis.Marks.Style := smsLabel;
  chartFrame.Chart.BottomAxis.Marks.Alignment := taCenter;
  chartFrame.SetTitle('Frequency distribution');
  chartFrame.SetXTitle(AVarName + ' categories');
  chartFrame.SetYTitle('Frequency');
  chartFrame.Chart.Legend.Visible := false;
end;


procedure TFreqFrm.PlotOptionsGroupSelectionChanged(Sender: TObject);
begin
  BarTypeGroup.Enabled := PlotOptionsGroup.ItemIndex in [0, 1, 8, 9];  // Bar series only
end;


procedure TFreqFrm.Reset;
var
  i: integer;
begin
  VarList.Clear;
  SelList.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  BarTypeGroup.ItemIndex := 0;
  PlotOptionsGroup.ItemIndex := 0;
  NormPltChk.Checked := false;

  ClearTabs;
  UpdateBtnStates;
end;


procedure TFreqFrm.ResetBtnClick(Sender: TObject);
begin
  Reset;
end;


procedure TFreqFrm.UpdateBtnStates;
var
  lSelected: Boolean;
  i: Integer;
  chartFrame: TChartFrame;
begin
  lSelected := false;
  for i := 0 to VarList.Items.Count-1 do
    if VarList.Selected[i] then
    begin
      lSelected := true;
      Break;
    end;
  InBtn.Enabled := lSelected;

  lSelected := false;
  for i := 0 to SelList.Items.Count-1 do
    if SelList.Selected[i] then
    begin
      lSelected := true;
      break;
    end;
  OutBtn.Enabled := lSelected;

  AllBtn.Enabled := VarList.Items.Count > 0;

  BarTypeGroup.Enabled := PlotOptionsGroup.ItemIndex in [0, 1, 8, 9];  // Bar series only

  FReportFrame.UpdateBtnStates;
  for i := 1 to PageControl.PageCount-1 do
  begin
    chartFrame := PageControl.Pages[i].Controls[0] as TChartFrame;
    chartFrame.UpdateBtnStates;
  end;
end;


procedure TFreqFrm.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);
    ClearTabs;
    UpdateBtnStates;
  end;
end;



procedure TFreqFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


end.