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

// Use file "BubblePlot2.laz" for testing

unit MultXvsYUnit;

{$mode objfpc}{$H+}
{$i ../../../LazStats.inc}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, Clipbrd,
  MainUnit, Globals, OutputUnit, DataProcs, DictionaryUnit, ContextHelpUnit;

type

  { TMultXvsYFrm }

  TMultXvsYFrm = class(TForm)
    Bevel1: TBevel;
    HelpBtn: TButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    XInBtn: TBitBtn;
    XOutBtn: TBitBtn;
    YInBtn: TBitBtn;
    YOutBtn: TBitBtn;
    GroupInBtn: TBitBtn;
    GroupOutBtn: TBitBtn;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    CloseBtn: TButton;
    DescChk: TCheckBox;
    LinesChk: TCheckBox;
    XEdit: TEdit;
    YEdit: TEdit;
    GroupEdit: TEdit;
    GroupBox1: TGroupBox;
    LabelEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    VarList: TListBox;
    procedure ComputeBtnClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure GroupInBtnClick(Sender: TObject);
    procedure GroupOutBtnClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
    procedure XInBtnClick(Sender: TObject);
    procedure XOutBtnClick(Sender: TObject);
    procedure YInBtnClick(Sender: TObject);
    procedure YOutBtnClick(Sender: TObject);
  private
    { private declarations }
    FAutoSized: Boolean;
    {$IFDEF USE_TACHART}
    procedure PlotXY(const XValues, YValues: DblDyneMat; MinGrp: Integer);
    {$ELSE}
    procedure PlotXY(const XValues, YValues: DblDyneMat;
      MaxX, MinX, MaxY, MinY: double; N, NoY, MinGrp: integer);
    {$ENDIF}
    procedure UpdateBtnStates;

  public
    { public declarations }
  end; 

var
  MultXvsYFrm: TMultXvsYFrm;

implementation

{$R *.lfm}

uses
  {$IFDEF USE_TACHART}
  TATypes,
  ChartFrameUnit, ChartUnit,
  {$ELSE}
  BlankFrmUnit,
  {$ENDIF}
  Math, Utils;


{ TMultXvsYFrm }

procedure TMultXvsYFrm.ResetBtnClick(Sender: TObject);
var
  i : integer;
begin
  VarList.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  XEdit.Text := '';
  YEdit.Text := '';
  GroupEdit.Text := '';
  DescChk.Checked := false;
  LinesChk.Checked := false;
  UpdateBtnStates;
end;


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


procedure TMultXvsYFrm.GroupInBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := VarList.ItemIndex;
  if (i > -1) and (GroupEdit.Text = '') then
  begin
    GroupEdit.Text := VarList.Items[i];
    VarList.Items.Delete(i);
  end;
  UpdateBtnStates;
end;


procedure TMultXvsYFrm.ComputeBtnClick(Sender: TObject);
var
  lReport: TStrings;
  i, N, NoGrps, XCol, YCol, GrpCol, Grp, MinGrp, MaxGrp: integer;
  MinX, MaxX, MinY, MaxY, X, Y: double;
  cellstring: string;
  MaxGrpSize: integer;
  NoInGrp: IntDyneVec = nil;
  XValues: DblDyneMat = nil;
  YValues: DblDyneMat = nil;
  Means: array[0..1] of Double = (0.0, 0.0);
  StdDevs: array[0..1] of Double = (0.0, 0.0);
  selected: array[0..2] of Integer = (0, 0, 0);
  NoSelected: Integer = 3;
begin
  MaxGrpSize := 0;
  MaxX := -Infinity;
  MinX := Infinity;
  MaxY := -Infinity;
  MinY := Infinity;

  // Get selected variables
  XCol := 0;
  YCol := 0;
  GrpCol := 0;
  for i := 1 to NoVariables do
  begin
    cellstring  :=  OS3MainFrm.DataGrid.Cells[i,0];
    if (cellstring = XEdit.Text) then selected[0] := i;
    if (cellstring = YEdit.Text) then selected[1] := i;
    if (cellstring = GroupEdit.Text) then selected[2] := i;
  end;
  XCol := selected[0];
  YCol := selected[1];
  GrpCol := selected[2];

  if (XCol = 0) or (YCol = 0) or (GrpCol = 0) then
  begin
    ErrorMsg('No variable selected.');
    exit;
  end;

  // Get number of groups
  MinGrp := MaxInt;
  MaxGrp := -MaxInt;
  for i := 1 to NoCases do
  begin
    Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol, i]);
    MaxGrp := Max(MaxGrp, Grp);
    MinGrp := Min(MinGrp, Grp);
  end;
  NoGrps := (MaxGrp - MinGrp) + 1;

  SetLength(XValues, NoGrps, NoCases);  // NoCases is over-dimensioned and will be trimmed later.
  SetLength(YValues, NoGrps, NoCases);  // dto.
  SetLength(NoInGrp, NoGrps);
  for i := 0 to NoGrps - 1 do NoInGrp[i] := 0;

  N := 0;
  for i := 1 to NoCases do
  begin
    if (not GoodRecord(i, NoSelected, selected))then continue;
    inc(N);

    X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol, i]);
    MaxX := Max(MaxX, X);
    MinX := Min(MinX, X);

    Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol, i]);
    MaxY := Max(MaxY, Y);
    MinY := Min(MinY, Y);

    Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol, i]) - MinGrp;
    XValues[Grp, NoInGrp[Grp]] := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol, i]);
    YValues[Grp, NoInGrp[Grp]] := Y;
    inc(NoInGrp[Grp]);
    MaxGrpSize := Max(MaxGrpsize, NoInGrp[Grp]);
  end;

  // Trim XValues and YValues to correct dimension.
  SetLength(XValues, NoGrps);
  SetLength(YValues, NoGrps);
  for grp := 0 to NoGrps-1 do
  begin
    SetLength(XValues[grp], NoInGrp[grp]);
    SetLength(YValues[grp], NoInGrp[grp]);
  end;

  // get descriptive data
  if DescChk.Checked then
  begin
    for i := 1 to NoCases do
    begin
      if (not GoodRecord(i,NoSelected,selected)) then continue;
      Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]);
      X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
      Means[0] := Means[0] + X;
      StdDevs[0] := StdDevs[0] + sqr(X);
      Means[1] :=  Means[1] + Y;
      StdDevs[1] := StdDevs[1] + sqr(Y);
    end;

    for i := 0 to 1 do
    begin
      StdDevs[i] := StdDevs[i] - sqr(Means[i]) / N;
      StdDevs[i] := sqrt(StdDevs[i] / (N - 1));
      Means[i] := Means[i] / N;
    end;

    lReport := TStringList.Create;
    try
      lReport.Add('X VERSUS Y FOR GROUPS PLOT');
      lReport.Add('');
      lReport.Add('X variable: ' + XEdit.Text);
      lReport.Add('Y variable: ' + YEdit.Text);
      lReport.Add('');

      lReport.Add('VARIABLE    MEAN   STANDARD DEVIATION');
      lReport.Add('   X   %9.3f %14.3f', [Means[0], StdDevs[0]]);
      lReport.Add('   Y   %9.3f %14.3f', [Means[1], StdDevs[1]]);
      lReport.Add('');

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

  // sort on X
  for i := 0 to NoGrps - 1 do
    SortOnX(XValues[i], YValues[i]);

  // Plot data
  PlotXY(XValues, YValues{$IFNDEF USE_TACHART}, MaxX, MinX, MaxY, MinY, MaxGrpSize, NoGrps{$ENDIF}, MinGrp);

  NoInGrp := nil;
  XValues := nil;
  YValues := nil;
end;


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

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

  Constraints.MinWidth := Width;
  Constraints.MinHeight := Height;

  FAutoSized := true;
end;


procedure TMultXvsYFrm.FormCreate(Sender: TObject);
begin
  Assert(OS3MainFrm <> nil);
  if DictionaryFrm = nil then Application.CreateForm(TDictionaryFrm, DictionaryFrm);
end;


procedure TMultXvsYFrm.FormShow(Sender: TObject);
begin
  ResetBtnClick(self);
end;


procedure TMultXvsYFrm.GroupOutBtnClick(Sender: TObject);
begin
  if GroupEdit.Text <> '' then
  begin
    VarList.Items.Add(GroupEdit.Text);
    GroupEdit.Text := '';
  end;
  UpdateBtnStates;
end;


procedure TMultXvsYFrm.HelpBtnClick(Sender: TObject);
begin
  if ContextHelpForm = nil then
    Application.CreateForm(TContextHelpForm, ContextHelpForm);
  ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;


procedure TMultXvsYFrm.XInBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := VarList.ItemIndex;
  if (i > -1) and (XEdit.Text = '') then
  begin
    XEdit.Text := VarList.Items[i];
    VarList.Items.Delete(i);
  end;
  UpdateBtnStates;
end;


procedure TMultXvsYFrm.XOutBtnClick(Sender: TObject);
begin
  if XEdit.Text <> '' then
  begin
    VarList.Items.Add(XEdit.Text);
    XEdit.Text := '';
  end;
  UpdateBtnStates;
end;


procedure TMultXvsYFrm.YInBtnClick(Sender: TObject);
var
  i: integer;
begin
  i := VarList.ItemIndex;
  if (i > -1) and (YEdit.Text = '') then
  begin
    YEdit.Text := VarList.Items[i];
    VarList.Items.Delete(i);
  end;
  UpdateBtnStates;
end;


procedure TMultXvsYFrm.YOutBtnClick(Sender: TObject);
begin
  if YEdit.Text <> '' then
  begin
    VarList.Items.Add(YEdit.Text);
    YEdit.Text := '';
  end;
  UpdateBtnStates;
end;


// Routine to plot X versus multiple Y values for several groups
// 1st index: group index, 2nd index: point index within group
{$IFDEF USE_TACHART}
procedure TMultXvsYFrm.PlotXY(const XValues, YValues: DblDyneMat; MinGrp: Integer);
var
  pt: TPlotType;
  grp: Integer;
  clr: TColor;
  grpName: String;
  sym: TSeriesPointerStyle;
begin
  if Length(XValues) <> Length(YValues) then
  begin
    ErrorMsg('Incorrect dimension of XValues and YValues');
    exit;
  end;

  if ChartForm = nil then
    ChartForm := TChartForm.Create(Application)
  else
    ChartForm.Clear;

  // Titles
  ChartForm.SetTitle(LabelEdit.Text);
  ChartForm.SetXTitle(XEdit.Text);
  chartForm.SetYTitle(YEdit.Text);

  if LinesChk.Checked then pt := ptLinesAndSymbols else pt := ptSymbols;

  for grp := 0 to Length(XValues)-1 do
  begin
    clr := DATA_COLORS[grp mod Length(DATA_COLORS)];
    sym := DATA_SYMBOLS[grp mod Length(DATA_SYMBOLS)];
    grpName := Format('%s = %d', [GroupEdit.Text, grp + MinGrp]);
    ChartForm.PlotXY(pt, XValues[grp], YValues[grp], nil, nil, grpName, clr, sym);
  end;

  ChartForm.Show;
end;
{$ELSE}
procedure TMultXvsYFrm.PlotXY(const XValues, YValues: DblDyneMat;
  MaxX, MinX, MaxY, MinY: double;  N, NoY, MinGrp: integer);
var
  xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
  vhi, hwide, offset, strhi, imagehi, i, j, Grp : integer;
  valincr, Yvalue, Xvalue, value : double;
  Title: string;
begin
  if BlankFrm = nil then
    Application.CreateForm(TBlankFrm, BlankFrm)
  else
    BlankFrm.Image1.Canvas.Clear;
  BlankFrm.Show;

  Title := LabelEdit.Text;
  BlankFrm.Caption := Title;
  BlankFrm.Show;

  imagewide := BlankFrm.Image1.Width;
  imagehi := BlankFrm.Image1.Height;
  vtop := 40;
  vbottom := ceil(imagehi) - 60;
  vhi := vbottom - vtop;
  hleft := 100;
  hright := imagewide - 80;
  hwide := hright - hleft;

  // Draw chart border and background
  BlankFrm.Image1.Canvas.Pen.Color := clBlack;
  BlankFrm.Image1.Canvas.Brush.Color := clWhite;
  BlankFrm.Image1.Canvas.Rectangle(0, 0, imagewide, imagehi);

  // Draw title
  if Title <> '' then
  begin
    xpos := (imagewide - BlankFrm.Image1.Canvas.TextWidth(Title)) div 2;
    yPos := 2;
    BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
  end;

  // draw horizontal axis
  BlankFrm.Image1.Canvas.Pen.Color := clBlack;
  BlankFrm.Image1.Canvas.MoveTo(hleft, vbottom);
  BlankFrm.Image1.Canvas.LineTo(hright, vbottom);
  valincr := (MaxX - MinX) / 10.0;
  for i := 1 to 11 do
  begin
    ypos := vbottom;
    Xvalue := MinX + valincr * (i - 1);
    xpos := hLeft + ceil(hwide * ((Xvalue - MinX) / (MaxX - MinX)));
    BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
    ypos := ypos + 10;
    BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
    Title := Format('%.2f', [Xvalue]);
    offset := BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
    xpos := xpos - offset;
    BlankFrm.Image1.Canvas.Pen.Color := clBlack;
    BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
  end;
  xpos := hleft + (hwide - BlankFrm.Image1.Canvas.TextWidth(XEdit.Text)) div 2;
  ypos := vbottom + 30;
  BlankFrm.Image1.Canvas.TextOut(xpos, ypos, XEdit.Text);

  // Draw vertical axis
  Title := 'Y VALUES';
  xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
  ypos := 8;
  BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
  xpos := hleft;
  ypos := vtop;
  BlankFrm.Image1.Canvas.MoveTo(xpos, ypos);
  ypos := vbottom;
  BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
  valincr := (MaxY - MinY) / 10.0;
  for i := 1 to 11 do
  begin
    value := MaxY - ((i-1) * valincr);
    Title := Format('%.2f',[value]);
    strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
    xpos := hleft - 20 - BlankFrm.Image1.Canvas.TextWidth(Title);
    Yvalue := MaxY - (valincr * (i-1));
    ypos := ceil(vhi * ( (MaxY - Yvalue) / (MaxY - MinY)));
    ypos := ypos + vtop - strhi div 2;
    BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
    xpos := hleft;
    ypos := ypos + strhi div 2;
    BlankFrm.Image1.Canvas.MoveTo(xpos, ypos);
    xpos := hleft - 10;
    BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
  end;

  // draw points for x and y pairs
  for j := 0 to NoY - 1 do
  begin
    BlankFrm.Image1.Canvas.Brush.Style := bsSolid;
    BlankFrm.Image1.Canvas.Brush.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
    BlankFrm.Image1.Canvas.Pen.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
    BlankFrm.Image1.Canvas.Font.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
    Grp := MinGrp + j;
    Title := 'GROUP ' + IntToStr(Grp);
    for i := 0 to N - 1 do
    begin
      xpos := hleft + ceil(hwide * ( (XValues[j, i] - MinX) / (MaxX - MinX)));
      ypos := vtop + ceil(vhi * ( (MaxY - YValues[j, i]) / (MaxY - MinY)));
      if (i = 0) then
        BlankFrm.Image1.Canvas.MoveTo(xpos, ypos);
      if LinesChk.Checked then
        BlankFrm.Image1.Canvas.LineTo(xpos, ypos);
      BlankFrm.Image1.Canvas.Ellipse(xpos, ypos, xpos+5, ypos+5);
    end;
    (*
    for i := 1 to N do
    begin
      ypos := vtop + ceil(vhi * ( (MaxY - YValues[i-1,j]) / (MaxY - MinY)));
      xpos := hleft + ceil(hwide * ( (XValues[i-1,j] - MinX) / (MaxX - MinX)));
      if (i = 1) then
        BlankFrm.Image1.Canvas.MoveTo(xpos, ypos);
      if LinesChk.Checked then
        BlankFrm.Image1.Canvas.LineTo(xpos, ypos);
      BlankFrm.Image1.Canvas.Ellipse(xpos, ypos, xpos+5, ypos+5);
    end;
    *)
    strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
    BlankFrm.Image1.Canvas.Brush.Color := clWhite;
    BlankFrm.Image1.Canvas.Pen.Color := clBlack;
    xpos := hwide + hleft;
    BlankFrm.Image1.Canvas.MoveTo(xpos, ypos-strhi);
    BlankFrm.Image1.Canvas.TextOut(xpos, ypos, Title);
  end;

  BlankFrm.Image1.Canvas.Font.Color := clBlack;
end;
{$ENDIF}


procedure TMultXvsYFrm.UpdateBtnStates;
var
  lSelected: Boolean;
  i: Integer;
begin
  lSelected := false;
  for i:=0 to VarList.Items.Count-1 do
    if VarList.Selected[i] then
    begin
      lSelected := true;
      break;
    end;

  XInBtn.Enabled := lSelected and (XEdit.Text = '');
  YInBtn.Enabled := lSelected and (YEdit.Text = '');
  GroupInBtn.Enabled := lSelected and (GroupEdit.Text = '');
  XOutBtn.Enabled := (XEdit.Text <> '');
  YOutBtn.Enabled := (YEdit.Text <> '');
  GroupOutBtn.Enabled := (GroupEdit.Text <> '');
end;


end.