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

unit StemLeafUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, Math, Clipbrd,
  MainUnit, Globals, BasicStatsReportFormUnit;

type
  { TStemLeafForm }

  TStemLeafForm = class(TBasicStatsReportForm)
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    TestChk: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    VarList: TListBox;
    SelectList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure SelectListDblClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
  private

  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;

  public
    constructor Create(AOwner: TComponent); override;
    procedure Reset; override;
  end; 

var
  StemLeafForm: TStemLeafForm;


implementation

{$R *.lfm}

uses
  Utils, MathUnit, GridProcs;


{ TStemLeafForm }

constructor TStemLeafForm.Create(AOwner: TComponent);
begin
  inherited;

  FReportFrame.BorderSpacing.Right := 0;
end;


procedure TStemLeafForm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
  ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
    TestChk.BorderSpacing.Top + TestChk.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


procedure TStemLeafForm.AllBtnClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to VarList.Items.Count-1 do
    SelectList.Items.Add(VarList.Items[i]);
  VarList.Clear;
  UpdateBtnStates;
end;


procedure TStemLeafForm.Compute;
var
  i, j, k, L, ncases, noselected, largest, smallest: integer;
  minsize, maxsize, stem, minstem, maxstem, bin, index: integer;
  leafvalue, counter, smallcount, testvalue, largestcount: integer;
  outline, astring: string;
  selected: IntDyneVec = nil;
  bins: IntDyneVec = nil;
  frequency: IntDyneVec = nil;
  ValueString: StrDyneVec = nil;
  values: DblDyneVec = nil;
  leafCount: IntDyneMat = nil;
  min, max, stemsize: double;
  lReport: TStrings;

begin
  noselected := SelectList.Items.Count;
  if (noselected = 0) then
  begin
     ErrorMsg('No variables were selected.');
     exit;
  end;

  SetLength(selected, noselected);
  SetLength(bins, 100);
  SetLength(frequency, 100);
  SetLength(leafCount, 100,10);

  // Get column indices of selected variables
  for i := 0 to noselected - 1 do
    selected[i] := GetVariableIndex(OS3MainFrm.DataGrid, SelectList.Items[i]);

  lReport := TStringList.Create;
  try
    lReport.Add('STEM AND LEAF PLOTS');
    lReport.Add('');

    // Analyze each variable selected
    for j := 0 to noselected - 1 do
    begin
      k := selected[j];
      lReport.Add('Stem and Leaf Plot for variable "%s"', [OS3MainFrm.DataGrid.Cells[k, 0]]);
      lReport.Add('');

      // Stores values of the variable
      values := CollectValues(OS3MainFrm.DataGrid, k);
      nCases := Length(values);
      SetLength(valueString, nCases);

      Calc_MaxMin(values, max, min);

      minSize := MaxInt;
      maxSize := -Maxint;
      for i := 0 to High(values) do
      begin
        valueString[i] := Trim(OS3MainFrm.DataGrid.Cells[k, i]);
        maxSize := Math.Max(maxSize, Length(valueString[i]));
        minSize := Math.Min(minSize, Length(valueString[i]));
      end;

      largest := ceil(max);
      smallest := ceil(min);
      stemsize := 1.0;
      if ((largest > 0) and (largest > 10)) then
      begin
        while (largest > 10) do
        begin
          largest := largest div 10;
          stemsize := stemsize * 10.0;
        end;
      end else
      if ((largest < 0) and (smallest < -10)) then  // largest value is less than 0.0
      begin
        while (smallest < -10)do
        begin
          smallest := smallest * 10;
          stemsize := stemsize / 10.0;
        end;
      end;

      // rescale values by stemsize
      for i := 0 to ncases - 1 do
        values[i] := values[i] / stemsize;

      // multiply values by 10, round and save value divided by 10
      for i := 0 to ncases - 1 do
      begin
        values[i] := floor(values[i] * 10) / 10;;
        ValueString[i] := Format('%4.1f', [values[i]]);
      end;

      // get max and min stem values for creating bins for stem values
      minstem := MaxInt;
      maxstem := -MaxInt;
      for i := 0 to ncases - 1 do
      begin
        stem := floor(values[i]);
        if (stem < minstem) then minstem := stem;
        if (stem > maxstem) then maxstem := stem;
      end;

      // create arrays for stem and leaf plot
      for i := 0 to 19 do
        frequency[i] := 0;

      // sort values into ascending order
      for i := 0 to ncases-2 do
      begin
        for k := i+1 to ncases - 1 do
        begin
          if (values[i] > values[k]) then // swap values
          begin
            Exchange(values[i], values[k]);
            Exchange(valueString[i], valueString[k]);
          end;
        end;
      end;
{
// check sizes - delete if ok
         outline := format('maxsize, minsize,stemsize: %10d %10d %10.2f',[maxsize, minsize, stemsize]);
         OutputFrm.RichEdit.Lines.Add(outline);
         OutputFrm.ShowModal;
         OutputFrm.RichEdit.Clear;
}
      if TestChk.Checked then
      begin   // test output
        lReport.Add('  Value      ValueString');
        lReport.Add('----------   --------------------');
        for i := 0 to ncases - 1 do
          lReport.Add('%10.1f   %s', [values[i], valueString[i]]);
        lReport.Add('');
      end;

      lReport.Add('Frequency  Stem & Leaf');

      // initialize leaf count for the bins
      for i := 0 to 99 do // bins
        for k := 0 to 9 do leafcount[i,k] := 0;  // leafs 0 to 9

      // count leafs in each bin
      for i := 0 to ncases - 1 do
      begin
        bin := floor(values[i]); // truncate to get stem value
        bin := bin - minstem; // get the bin number between 0 and 100
        if (bin < 100) and (bin >= 0) then
        begin
          bins[bin] := floor(values[i]);
          frequency[bin] := frequency[bin] + 1; // count number of stem values
        end else
        begin
          ErrorMsg('Error in bin value');
          exit;
        end;

        // get leaf value
        astring := ValueString[i];
        index := Pos('.',astring);
        leafvalue := StrToInt(astring[index+1]);
        if (leafvalue < 10) and (leafvalue >= 0) then
           leafcount[bin,leafvalue] := leafcount[bin,leafvalue] + 1
        else
        begin
          ErrorMsg('Error in leafvalue');
          exit;
        end;
      end;

      // get max leaf counters
      largestCount := 0;
      for i := 0 to 99 do // bin
      begin
        if frequency[i] = 0 then continue; // skip empty bins
        counter := 0;
        for k := 0 to 9 do // leaf counts
          counter := counter + leafcount[i,k];
        if counter > largestcount then
          largestcount := counter;
      end;

      // determine leaf depth needed to get counter <= 50
      if (largestCount > 50) then
      begin
        smallCount := 2;
        testvalue := largestCount;
        while (testvalue > 50) do
        begin
          testvalue := largestCount div smallCount;
          smallCount := smallCount + 1;
        end;
        smallCount := smallCount - 1; // leaf depth needed to reduce line lengths to 50 or less
      end else
        smallCount := 1;

      // rescale leafs
      for i := 0 to 99 do // bin
        for k := 0 to 9 do // leaf
          leafCount[i,k] := leafCount[i,k] div smallcount;

      // plot results
      for i := 0 to 99 do
      begin
        if frequency[i] = 0 then continue; // skip empty bins
        outline := format('%6d     %3d    ',[frequency[i], bins[i]]);
        for k := 0 to 9 do
        begin
          if leafCount[i,k] = 0 then continue;
          for L := 1 to leafCount[i,k] do
            outline := outline + Format('%d',[k]);
        end;
        lReport.Add(outline);
      end;

      // summarize values
      lReport.Add('');
      lReport.Add('Stem Width:         %8.3f', [stemSize]);
      lReport.Add('Max. Leaf Depth:    %8d',   [smallcount]);
      lReport.Add('Min. Value:         %8.3f', [min]);
      lReport.Add('Max. Value:         %8.3f', [max]);
      lReport.Add('No. of good cases:  %8d',   [ncases]);
      lReport.Add('');
      lReport.Add(DIVIDER_SMALL);
      lReport.Add('');
    end;

    FReportFrame.DisplayReport(lReport);

  finally
    lReport.Free;
  end;
end;


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


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

procedure TStemLeafForm.Reset;
var
  i: integer;
begin
  inherited;

  VarList.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  SelectList.Clear;
  UpdateBtnStates;
end;


procedure TStemLeafForm.SelectListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := Selectlist.ItemIndex;
  if index > -1 then
  begin
    VarList.Items.Add(SelectList.Items[index]);
    SelectList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


procedure TStemLeafForm.UpdateBtnStates;
var
  lSelected: Boolean;
  i: Integer;
begin
  inherited;
	
  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 SelectList.Items.Count-1 do
    if SelectList.Selected[i] then
    begin
      lSelected := true;
      break;
    end;
  OutBtn.Enabled := lSelected;
end;


procedure TStemLeafForm.VarListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := VarList.ItemIndex;
  if index > -1 then
  begin
     SelectList.Items.Add(VarList.Items[index]);
     VarList.Items.Delete(index);
     UpdateBtnStates;
  end;
end;


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

end.