lazarus-ccr/applications/lazstats/source/forms/simulations/hypergeounit.pas

unit HyperGeoUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, ExtCtrls,
  FunctionsLib, BasicStatsReportFormUnit;

type

  { THyperGeoForm }

  THyperGeoForm = class(TBasicStatsReportForm)
    SampSizeEdit: TEdit;
    SampObsEdit: TEdit;
    PopSizeEdit: TEdit;
    PopObsEdit: TEdit;
    ProbXEdit: TEdit;
    ProbGTEdit: TEdit;
    ProbLEEdit: TEdit;
    ProbGEEdit: TEdit;
    ProbLTEdit: TEdit;
    SampSizeLabel: TLabel;
    SampObsLabel: TLabel;
    PopObsLabel: TLabel;
    PopSizeLabel: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
  private
    { private declarations }
    procedure FisherTable(A,B,C,D, p, SumP: double; AReport: TStrings);
		
  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
		
  public
    procedure Reset; override;

  end; 

var
  HyperGeoForm: THyperGeoForm;


implementation

{$R *.lfm}

uses
  Math;


{ THyperGeoForm }

procedure THyperGeoForm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinHeight := ProbLTEdit.Top + ProbLTEdit.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
  ParamsPanel.Constraints.MinWidth := Max(
    Max(PopSizeLabel.Width, Label8.Width) + Label8.BorderSpacing.Left + ProbGEEdit.BorderSpacing.Left + ProbGEEdit.Width,
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left
  );;
end;


procedure THyperGeoForm.Compute;
var
  SampObs, PopObs, SampSize, PopSize: double;
  A, B, C, D, APlusB, CPlusD: double;
  ProbX, Prob, SumProb, ProbGE, ProbGT, ProbLT, ProbLE: double;
  done: boolean;
  lReport: TStrings;
begin
  lReport := TStringList.Create;
  try
    lReport.Add('HYPERGEOMETRIC DISTRIBUTION CALCULATIONS');
    lReport.Add('Accumulating Values of the distribution');
    lReport.Add('');

    label5.Enabled := true;
    label6.Enabled := true;
    label7.Enabled := true;
    label8.Enabled := true;
    label9.Enabled := true;
    ProbXEdit.Enabled := true;
    ProbGEEdit.Enabled := true;
    ProbLTEdit.Enabled := true;
    ProbLEEdit.Enabled := true;
    ProbGTEdit.Enabled := true;

    SampObs := StrToFloat(SampObsEdit.Text);
    PopObs := StrToFloat(PopObsEdit.Text);
    SampSize := StrToFloat(SampSizeEdit.Text);
    PopSize := StrToFloat(PopSizeEdit.Text);

    done := false;
    SumProb := 0.0;

    A := SampObs;
    B := SampSize - A;
    C := PopObs;
    D := PopSize - C;
    APlusB := A + B;
    CPlusD := C + D;

    ProbX := combos(A,C) * combos(B,D) / combos(APlusB,CPlusD);
    ProbXEdit.Text := Format('%.4f', [ProbX]);
    SumProb := SumProb + ProbX;
    FisherTable(A,B,C,D,ProbX,SumProb, lReport);

    // get more extreme probabilities
    while not done do
    begin
      if A = APlusB then
        done := true
      else
      begin
        A := A + 1;
        B := B - 1;
        if (A < 0) or (B < 0) or (C < 0) or (D < 0) then done := true;
      end;
      if not done then
      begin
        Prob := combos(A,C) * combos(B,D) / combos(APlusB,CPlusD);
        SumProb := SumProb + Prob;
        FisherTable(A,B,C,D,Prob,SumProb, lReport);
        lReport.Add('');
      end;
    end; // end while not done

    ProbGE := SumProb;
    ProbGT := SumProb - ProbX;
    ProbLT := 1.0 - ProbGE;
    ProbLE := ProbLT + ProbX;
    ProbGEEdit.Text := Format('%.4f', [ProbGE]);
    ProbLEEdit.Text := Format('%.4f', [ProbLE]);
    ProbGTEdit.Text := Format('%.4f', [ProbGT]);
    ProbLTEdit.Text := Format('%.4f', [ProbLT]);

    FReportFrame.DisplayReport(lReport);
  finally
    lReport.Free;
  end;
end;


procedure THyperGeoForm.FisherTable(A,B,C,D, p, SumP: double; AReport: TStrings);
begin
  AReport.Add('Table for Hypergeometric Probabilities');
  AReport.Add('----------------------------------');
  AReport.Add(' Row             Column           ');
  AReport.Add('             1              2     ');
  AReport.Add(' ---     ----------    -----------');
  AReport.Add('  1      %8.0f       %8.0f', [A, B]);
  AReport.Add('  2      %8.0f       %8.0f', [C, D]);
  AReport.Add('----------------------------------');
  AReport.Add('Probability:            %8.4f', [p]);
  AReport.Add('Cumulative Probability: %8.4f', [SumP]);
  AReport.Add('');
end;


procedure THyperGeoForm.Reset;
begin
  inherited;

  SampSizeEdit.Text := '';
  SampObsEdit.Text := '';
  PopSizeEdit.Text := '';
  PopObsEdit.Text := '';
  ProbXEdit.Text := '';
  ProbGEEdit.Text := '';
  ProbLTEdit.Text := '';
  ProbLEEdit.Text := '';
  ProbGTEdit.Text := '';
  label5.Enabled := false;
  label6.Enabled := false;
  label7.Enabled := false;
  label8.Enabled := false;
  label9.Enabled := false;
  ProbXEdit.Enabled := false;
  ProbGEEdit.Enabled := false;
  ProbLTEdit.Enabled := false;
  ProbLEEdit.Enabled := false;
  ProbGTEdit.Enabled := false;
end;


function THyperGeoForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var
  n: Integer;
begin
  Result := false;

  if (SampSizeEdit.Text = '') or not TryStrToInt(SampSizeEdit.Text, n) or (n <= 0) then
  begin
    AMsg := 'Valid positive integer number required.';
    AControl := SampSizeEdit;
    exit;
  end;

  if (SampObsEdit.Text = '') or not TryStrToInt(SampObsEdit.Text, n) or (n <= 0) then
  begin
    AMsg := 'Valid positive integer number required.';
    AControl := SampObsEdit;
    exit;
  end;

  if (PopSizeEdit.Text = '') or not TryStrToInt(PopSizeEdit.Text, n) or (n <= 0) then
  begin
    AMsg := 'Valid positive integer number required.';
    AControl := PopSizeEdit;
    exit;
  end;

  if (PopObsEdit.Text = '') or not TryStrToInt(PopObsEdit.Text, n) or (n <= 0) then
  begin
    AMsg := 'Valid positive integer number required.';
    AControl := PopObsEdit;
    exit;
  end;

  Result := true;
end;

end.