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

// Use "cansas.laz" for testing.

unit FreqUnit;

{$mode objfpc}{$H+}

interface

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

type

  { TFreqFrm }

  TFreqFrm = class(TBasicStatsForm)
    Bevel1: TBevel;
    BinSelectionGroup: TGroupBox;
    ThreeDChk: TCheckBox;
    ComputeBtn: TButton;
    PlotOptionsGroup: TGroupBox;
    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;
    ParamsSplitter: TSplitter;
    ReportPage: TTabSheet;
    NoIntervalsEdit: TSpinEdit;
    HorBarsBtn: TSpeedButton;
    LinePlotBtn: TSpeedButton;
    AreaPlotBtn: TSpeedButton;
    VertBarsBtn: TSpeedButton;
    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 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 CalcIntervals(var AMin, AMax, AIntervalSize: Double;
      out ANumIntervals: Integer);
    procedure ClearTabs;
    function CreateOrGetChartFrame(AColIndex: Integer; AVarName: String): TChartFrame;
    function GetPageCaption(AVarName: String): String;
    procedure PlotFreq(AChartFrame: TChartFrame; AColIndex: Integer;
      AVarName: String; const xLabels: StrDyneVec;
      const Freq: DblDyneVec);
    procedure PlotNormalDist(AChartFrame: TChartFrame; Freq: DblDyneVec);
    procedure UpdateBtnStates;
  public
    { public declarations }
    procedure Reset; override;
  end; 

var
  FreqFrm: TFreqFrm;


implementation

{$R *.lfm}

uses
  Math, TAChartUtils, TALegend, TASources, TACustomSeries, TASeries,
  Utils, MathUnit;

{ 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.CalcIntervals(var AMin, AMax, AIntervalsize: Double;
  out ANumIntervals: Integer);
var
  intervalSize: Double;
  m: Double;
  e: Integer;
begin
//  intervalSize := round((AMax - AMin) / NoIntervalsEdit.Value);
  intervalSize := (AMax - AMin) / NoIntervalsEdit.Value;
  if intervalSize = 0 then intervalSize := 1;
  MantisseAndExponent(intervalSize, m, e);
  m := round(m);
  AIntervalSize := m * IntPower(10, e);
  AMin := floor(AMin / AIntervalSize) * AIntervalSize;
  AMax := ceil(AMax / AIntervalSize) * AIntervalSize;
  ANumIntervals := round((AMax - AMin) / AIntervalSize);
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;
  normDistValue: DblDyneVec = nil;
  value: double;
  NoVars: integer;
  cellval: string;
  mask: String;
  col: integer;
  min, max: double;
  incrSize: double = 1;
  nInts: integer;
  Sumx, Sumx2, Mean, Variance, StdDev, zlow, zhi: double;
  X, zproplow, zprophi, zfreq: double;
  nCases: integer;
  lReport: TStrings;
  chartFrame: TChartFrame;
begin
  if SelList.Count = 0 then
  begin
    ErrorMsg('No variable(s) selected.');
    exit;
  end;

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

    // Iterate through all variables
    NoVars := SelList.Items.Count;
    for i := 1 to NoVars do
    begin
      // Get column index 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;

      CalcIntervals(min, max, incrSize, nInts);

      SetLength(freq, nInts);
      SetLength(cumFreq, nInts);
      SetLength(XValue, nInts);
      SetLength(XLabels, nInts);
      SetLength(pcnt, nInts);
      SetLength(cumPcnt, nInts);
      Setlength(pcntileRank, 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;

      // Create x axis labels for the chart
      if HorBarsBtn.Down then
        mask := '%.2f to %.2f'
      else
        mask := '%.2f' + LineEnding + 'to' + LineEnding + '%.2f';
      for j := 0 to nInts-1 do
      begin
        XValue[j] := min + j * incrSize;
        XLabels[j] := Format(mask, [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 - 1 do
      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;

      if NormPltChk.Checked then
      begin
        // 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 NoCases do
        begin
          if not ValidValue(k, col) then continue;
          value := StrToFloat(OS3MainFrm.DataGrid.Cells[col, k]);
          sumx := sumx + value;
          sumx2 := sumx2 + sqr(value);
        end;
        Mean := sumx / nCases;
        Variance := sumx2 - sqr(sumx) / nCases;
        Variance := Variance / (nCases - 1);
        StdDev := sqrt(Variance);

        SetLength(normDistValue, nInts);

        for k := 0 to nInts-1 do
        begin
          X := XValue[k];
          if StdDev > 0.0 then
            zLow := (X - Mean) / StdDev
          else
            zLow := 0.0;
          X := XValue[k] + incrSize;
          if StdDev > 0.0 then
            zHi := (X - Mean) / StdDev
          else
            zHi := 0.0;

          // Get cumulative proportion for this z and translate to frequency
          zPropLow := NormalDist(zLow);
          zPropHi := NormalDist(zHi);
          zFreq := nCases * abs(zPropHi - zPropLow);
          normDistValue[k] := zFreq;
        end;

        // Print results to report
        lReport.Add('    FROM    TO      FREQ.   PCNT    CUM.FREQ. CUM.PCNT. %ILE RANK   ND FREQ.');
        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  %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
            normDistValue[k]       // normal distribution value
          ]);
      end
      else
      begin
        // 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
          ]);
      end;

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

      // Plot data
      chartFrame := CreateOrGetChartFrame(col, cellVal);
      chartFrame.Clear;
      if NormPltChk.Checked then
        PlotNormalDist(chartFrame, normDistValue);
      PlotFreq(chartFrame, col, cellVal, xLabels, freq);
    end;
  finally
    lReport.Free;
  end;
end;


function TFreqFrm.CreateOrGetChartFrame(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 := AllBtn.Top + AllBtn.Height;
  Panel1.Constraints.MinWidth := Max(Label1.Width, Label2.Width) + AllBtn.Width + VarList.BorderSpacing.Right*2;
  ParamsPanel.Constraints.MinHeight := Panel1.Constraints.MinHeight +
    NormPltChk.BorderSpacing.Top + NormPltChk.Height +
    BinSelectionGroup.BorderSpacing.Top + BinSelectionGroup.Height +
    PlotOptionsGroup.BorderSpacing.Top + PlotOptionsGroup.Height +
    Bevel1.Height +
    CloseBtn.BorderSpacing.Top + CloseBtn.Height;
  ParamsPanel.Constraints.MinWidth := Max(
    3*w + 2 * CloseBtn.BorderSpacing.Left,
    Panel1.Constraints.MinWidth) + ParamsPanel.BorderSpacing.left*2;

  Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300;
  Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + ParamsPanel.BorderSpacing.Top*2;
  if Width < Constraints.MinWidth then Width := 1;     // trigger autoscaling
  if Height < Constraints.MinHeight then Height := 1;

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


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

  InitForm(Self);

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

  Position := poDefault;
  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(AChartFrame: TChartFrame; AColIndex: Integer;
  AVarName: String; const xLabels: StrDyneVec; const Freq: DblDyneVec);
var
  ser: TChartSeries;
  isRotated: Boolean;
  margin: Integer;
  source: TListChartSource;
  i: Integer;
begin
  isRotated := false;

  // *** BAR series ***
  if VertBarsBtn.Down or HorBarsBtn.Down then
  begin
    ser := AChartFrame.PlotXY(ptBars, nil, Freq, xLabels, nil, 'Data', clDefault);
    with (ser as TBarSeries) do
    begin
      BarBrush.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)];
      {$IF LCL_FullVersion >= 2010000}
      DepthBrightnessDelta := -30;
      {$IFEND}
    end;
    if HorBarsBtn.Down then
      isRotated := true;
    margin := 0;
  end
  else
  // *** LINE series ***
  if LinePlotBtn.Down then
  begin
    ser := AChartFrame.PlotXY(ptLines, nil, Freq, xLabels, nil, 'Data', clDefault);
    with TLineSeries(ser) do
    begin
      LinePen.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)];
      {$IF LCL_FullVersion >= 2010000}
      DepthBrightnessDelta := -30;
      {$IFEND}
    end;
    margin := 4;
  end
  else
  // *** AREA series ***
  if AreaPlotBtn.Down then
  begin
    ser := AChartFrame.PlotXY(ptArea, nil, Freq, xLabels, nil, 'Data', clDefault);
    with TAreaSeries(ser) do
    begin
      AreaBrush.Color := DATA_COLORS[(AColIndex-1) mod Length(DATA_COLORS)];
      AreaLinesPen.Color := AreaBrush.Color;
      AreaContourPen.Color := clBlack; //AreaBrush.Color;
      {$IF LCL_FullVersion >= 2010000}
      DepthBrightnessDelta := -30;
      {$IFEND}
    end;
    margin := 0;
  end;

  ser.Legend.Order := 0;
  if ThreeDChk.Checked then
    ser.Depth := 20;

  source := TListChartSource.Create(AChartFrame);
  for i := 0 to ser.Source.Count-1 do
    source.Add(ser.Source[i]^.X, ser.Source[i]^.X, ser.Source[i]^.Text);

  AChartFrame.SetTitle('Frequency distribution');
  AChartFrame.Chart.Legend.Visible := NormPltChk.Checked;
  if isRotated then
  begin
    ser.AxisIndexX := 0;
    ser.AxisIndexY := 1;
    AChartFrame.SetXTitle('Frequency');
    AChartFrame.SetYTitle(AVarName + ' categories');
    AChartFrame.Chart.Margins.Bottom := 4;
    AChartFrame.Chart.BottomAxis.Marks.Source := nil;
    AChartFrame.Chart.BottomAxis.Marks.Style := smsValue;
    AChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter;
    AChartFrame.Chart.Margins.Left := margin;
    AChartFrame.Chart.LeftAxis.Marks.Source := source;
    AChartFrame.Chart.LeftAxis.Marks.Style := smsLabel;
    AChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter;
  end else
  begin
    ser.AxisIndexX := 1;
    ser.AxisIndexY := 0;
    AChartFrame.SetXTitle(AVarName + ' categories');
    AChartFrame.SetYTitle('Frequency');
    AChartFrame.Chart.Margins.Bottom := margin;
    AChartFrame.Chart.BottomAxis.Marks.Source := source;
    AChartFrame.Chart.BottomAxis.Marks.Style := smsLabel;
    AChartFrame.Chart.BottomAxis.Marks.Alignment := taCenter;
    AChartFrame.Chart.Margins.Left := 4;
    AChartFrame.Chart.LeftAxis.Marks.Source := nil;
    AChartFrame.Chart.LeftAxis.Marks.Style := smsValue;
    AChartFrame.Chart.LeftAxis.Marks.Alignment := taCenter;
  end;
end;


procedure TFreqFrm.PlotNormalDist(AChartFrame: TChartFrame; Freq: DblDyneVec);
var
  ser: TLineSeries;
begin
  ser := AChartFrame.PlotXY(ptLines, nil, Freq, nil, nil, 'Normal Dist.', clBlack) as TLineSeries;

  if HorBarsBtn.Down then
  begin
    ser.AxisIndexX := 0;
    ser.AxisIndexY := 1;
  end;
  if ThreeDChk.Checked then
  begin
    ser.LinePen.Color := clGray;
    ser.LinePen.Width := 1;
    ser.Depth := 20;
  end else
    ser.LinePen.Width := 2;
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]);
  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;

  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.