lazarus-ccr/applications/lazstats/source_orig/multxvsyunit.pas

unit MultXvsYUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, MainUnit, Globals, functionsLib, OutPutUnit, DataProcs,
  DictionaryUnit, Math, Clipbrd, contexthelpunit;


type

  { TMultXvsYFrm }

  TMultXvsYFrm = class(TForm)
    HelpBtn: TButton;
    XInBtn: TBitBtn;
    XOutBtn: TBitBtn;
    YInBtn: TBitBtn;
    YOutBtn: TBitBtn;
    GroupInBtn: TBitBtn;
    GroupOutBtn: TBitBtn;
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: 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 FormShow(Sender: TObject);
    procedure GroupInBtnClick(Sender: TObject);
    procedure GroupOutBtnClick(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure XInBtnClick(Sender: TObject);
    procedure XOutBtnClick(Sender: TObject);
    procedure YInBtnClick(Sender: TObject);
    procedure YOutBtnClick(Sender: TObject);
  private
    { private declarations }
    procedure plotxy(var XValues : DblDyneMat;
                     YValues : DblDyneMat;
                     MaxX, MinX, MaxY, MinY : double;
                     N, NoY, MinGrp : integer);

  public
    { public declarations }
  end; 

var
  MultXvsYFrm: TMultXvsYFrm;

implementation
uses BlankFrmUnit;

{ 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;
        XInBtn.Visible := true;
        YInBtn.Visible := true;
        GroupInBtn.Visible := true;
        XOutBtn.Visible := false;
        YOutBtn.Visible := false;
        GroupOutBtn.Visible := false;
end;

procedure TMultXvsYFrm.GroupInBtnClick(Sender: TObject);
VAR i : integer;
begin
        i := VarList.ItemIndex;
        GroupEdit.Text := VarList.Items.Strings[i];
        VarList.Items.Delete(i);
        GroupInBtn.Visible := false;
        GroupOutBtn.Visible := true;
end;

procedure TMultXvsYFrm.ComputeBtnClick(Sender: TObject);
var
        i, j, k, N, NoGrps, XCol, YCol, GrpCol, Grp, MinGrp, MaxGrp : integer;
        NoSelected, MaxGrpSize : integer;
        selected, NoInGrp : IntDyneVec;
        YValues, XValues : DblDyneMat;
        Means, StdDevs : DblDyneVec;
        MinX, MaxX, MinY, MaxY, X, Y, temp : double;
        cellstring, prtline : string;

begin
        MaxGrpSize := 0;
        SetLength(selected,3);
        MaxX := -1.0e20;
        MinX := 1.0e20;
        MaxY := -1.0e20;
        MinY := 1.0e20;
        MinGrp := 1000;
        MaxGrp := -1000;
        N:=0;

        // Get selected variables
        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];
        NoSelected := 3;

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

        OutPutFrm.RichEdit.Clear;
        OutPutFrm.RichEdit.Lines.Add('X VERSUS Y FOR GROUPS PLOT');
        OutPutFrm.RichEdit.Lines.Add('');
        SetLength(YValues,NoCases+1,NoGrps+1);
        SetLength(XValues,NoCases+1,NoGrps+1);
        SetLength(Means,2);
        SetLength(StdDevs,2);
        SetLength(NoInGrp,NoGrps);

        for i := 0 to 1 do
        begin
                Means[i] := 0.0;
                StdDevs[i] := 0.0;
        end;
        for i := 0 to NoGrps - 1 do NoInGrp[i] := 0;

        for i := 1 to NoCases do
        begin
                if (not GoodRecord(i,NoSelected,selected))then continue;
                N := N + 1;
                X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
                if (X > MaxX) then MaxX := X;
                if (X < MinX) then MinX := X;
                Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]);
                if (Y > MaxY) then MaxY := Y;
                if (Y < MinY) then MinY := Y;
        end;

        for i := 1 to NoCases do
        begin
                if (not GoodRecord(i,NoSelected,selected))then continue;
                Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,i]);
                if (Y > MaxY) then MaxY := Y;
                if (Y < MinY) then MinY := Y;
                Grp := StrToInt(OS3MainFrm.DataGrid.Cells[GrpCol,i]);
                Grp := Grp - MinGrp;
                NoInGrp[Grp] := NoInGrp[Grp] + 1;
                if (NoInGrp[Grp] > MaxGrpSize) then MaxGrpSize := NoInGrp[Grp];
                YValues[NoInGrp[Grp]-1,Grp] := Y;
                XValues[NoInGrp[Grp]-1,Grp] := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,i]);
        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] + (X * X);
                        Means[1] :=  Means[1] + Y;
                        StdDevs[1] := StdDevs[1] + (Y * Y);
                end;
                for i := 0 to 1 do
                begin
                        StdDevs[i] := StdDevs[i] - (Means[i] * Means[i]) / N;
                        StdDevs[i] := StdDevs[i] / (N - 1);
                        StdDevs[i] := sqrt(StdDevs[i]);
                        Means[i] := Means[i] / N;
                end;
                OutPutFrm.RichEdit.Lines.Add('VARIABLE  MEAN    STANDARED DEVIATION');
                prtline := format('   X      %9.3f %8.3f',[Means[0],StdDevs[0]]);
                OutPutFrm.RichEdit.Lines.Add(prtline);
                prtline := format('   Y      %9.3f %8.3f',[Means[1],StdDevs[1]]);
                OutPutFrm.RichEdit.Lines.Add(prtline);
                OutPutFrm.RichEdit.Lines.Add('');
                OutPutFrm.ShowModal;
        end;

        // sort on X
        for i := 0 to NoGrps - 1 do
        begin
                for j := 0 to MaxGrpSize-2 do
                begin
                        for k := j+1 to MaxGrpSize - 1 do
                        begin
                                if (XValues[j,i] > XValues[k,i]) then // swap
                                begin
                                        temp := XValues[j,i];
                                        XValues[j,i] := XValues[k,i];
                                        XValues[k,i] := temp;
                                        temp := YValues[j,i];
                                        YValues[j,i] := YValues[k,i];
                                        YValues[k,i] := temp;
                                end;
                        end;
                end;
        end;

        BlankFrm.Show;
        plotxy(XValues, YValues, MaxX, MinX, MaxY, MinY, MaxGrpSize, NoGrps, MinGrp);

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

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

procedure TMultXvsYFrm.GroupOutBtnClick(Sender: TObject);
begin
        VarList.Items.Add(GroupEdit.Text);
        GroupEdit.Text := '';
        GroupInBtn.Visible := true;
        GroupOutBtn.Visible := false;
end;

procedure TMultXvsYFrm.HelpBtnClick(Sender: TObject);
begin
  ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;

procedure TMultXvsYFrm.XInBtnClick(Sender: TObject);
VAR i : integer;
begin
        i := VarList.ItemIndex;
        XEdit.Text := VarList.Items.Strings[i];
        VarList.Items.Delete(i);
        XInBtn.Visible := false;
        XOutBtn.Visible := true;
end;

procedure TMultXvsYFrm.XOutBtnClick(Sender: TObject);
begin
        VarList.Items.Add(XEdit.Text);
        XEdit.Text := '';
        XInBtn.Visible := true;
        XOutBtn.Visible := false;
end;

procedure TMultXvsYFrm.YInBtnClick(Sender: TObject);
VAR i : integer;
begin
        i := VarList.ItemIndex;
        YEdit.Text := VarList.Items.Strings[i];
        VarList.Items.Delete(i);
        YInBtn.Visible := false;
        YOutBtn.Visible := true;
end;

procedure TMultXvsYFrm.YOutBtnClick(Sender: TObject);
begin
        VarList.Items.Add(YEdit.Text);
        YEdit.Text := '';
        YInBtn.Visible := true;
        YOutBtn.Visible := false;
end;

procedure TMultXvsYFrm.plotxy(var XValues : DblDyneMat;
                              YValues : DblDyneMat;
                              MaxX, MinX, MaxY, MinY : double;
                              N, NoY, MinGrp : integer);
var
     // routine to plot X versus multiple Y values
     xpos, ypos, hleft, hright, vtop, vbottom, imagewide : integer;
     vhi, hwide, offset, strhi, imagehi, i, j, k, Grp : integer;
     maxval, minval, valincr, Yvalue, Xvalue, value : double;
     Title, outline : string;
     Colors : array[0..12] of TColor;
begin
     Colors[1] := clRed;
     Colors[2] := clBlue;
     Colors[3] := clGreen;
     Colors[4] := clNavy;
     Colors[5] := clTeal;
     Colors[6] := clAqua;
     Colors[7] := clLime;
     Colors[8] := clFuchsia;
     Colors[9] := clGray;
     Colors[10] := clPurple;
     Colors[11] := clOlive;
     Colors[0] := clMaroon;
     Title := LabelEdit.Text;
     BlankFrm.Image1.Canvas.Clear;
     BlankFrm.Caption := Title;
     imagewide := BlankFrm.Image1.Width;
     imagehi := BlankFrm.Image1.Height;
//     ImageFrm.Image.Canvas.FloodFill(0,0,clWhite,fsBorder);
     vtop := 20;
     vbottom := ceil(imagehi) - 80;
     vhi := vbottom - vtop;
     hleft := 100;
     hright := imagewide - 80;
     hwide := hright - hleft;
     BlankFrm.Image1.Canvas.Pen.Color := clBlack;
     BlankFrm.Image1.Canvas.Brush.Color := clWhite;

     // Draw chart border
//     ImageFrm.Image.Canvas.Rectangle(0,0,imagewide,imagehi);

     // 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 10 do
     begin
          ypos := vbottom;
          Xvalue := MinX + valincr * (i - 1);
          xpos := ceil(hwide * ((Xvalue - MinX) / (MaxX - MinX)));
          xpos := xpos + hleft;
          BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
          ypos := ypos + 10;
          BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
          outline := format('%6.2f',[Xvalue]);
          Title := outline;
          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 div 2) - (BlankFrm.Image1.Canvas.TextWidth(XEdit.Text) div 2);
     ypos := vbottom + 20;
     BlankFrm.Image1.Canvas.TextOut(xpos,ypos,XEdit.Text);

     // Draw vertical axis
     Title := 'Y VALUES';
     xpos := hleft - BlankFrm.Image1.Canvas.TextWidth(Title) div 2;
     ypos := vtop - BlankFrm.Image1.Canvas.TextHeight(Title);
     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 10 do
     begin
          value := MaxY - ((i-1) * valincr);
          outline := format('%8.2f',[value]);
          Title := outline;
          strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
          xpos := 10;
          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 := Colors[j mod 12];
        BlankFrm.Image1.Canvas.Pen.Color := Colors[j mod 12];
        Grp := MinGrp + j;
        Title := 'GROUP ' + IntToStr(Grp);
        for i := 1 to N do
        begin
                ypos := ceil(vhi * ( (MaxY - YValues[i-1,j]) / (MaxY - MinY)));
                ypos := ypos + vtop;
                xpos := ceil(hwide * ( (XValues[i-1,j] - MinX) / (MaxX - MinX)));
                xpos := xpos + hleft;
                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;
end;

initialization
  {$I multxvsyunit.lrs}

end.