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

unit XvsMultYUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls, MainUnit, Globals, Math, OutPutUnit,
  FunctionsLib, DataProcs, BlankFrmUnit, Printers, MatrixLib;

type

  { TXvsMultYForm }

  TXvsMultYForm = class(TForm)
    CancelBtn: TButton;
    LinesBox: TCheckBox;
    DescChk: TCheckBox;
    GroupBox1: TGroupBox;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: TButton;
    PlotTitleEdit: TEdit;
    Label4: TLabel;
    YBox: TListBox;
    XEdit: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    XInBtn: TBitBtn;
    YInBtn: TBitBtn;
    Label1: TLabel;
    XOutBtn: TBitBtn;
    YOutBtn: TBitBtn;
    VarList: TListBox;
    Memo1: TMemo;
    procedure ComputeBtnClick(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 }
    selected : IntDyneVec;

    procedure plotxy(XValues : DblDyneVec; YValues : DblDyneMat; MaxX, MinX,
       MaxY, MinY : double; N, NoY : integer);
  public
    { public declarations }
  end; 

var
  XvsMultYForm: TXvsMultYForm;

implementation

{ TXvsMultYForm }

procedure TXvsMultYForm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     VarList.Clear;
     YBox.Clear;
     XEdit.Clear;
     XInBtn.Visible := true;
     XOutBtn.Visible := false;
     YInBtn.Visible := true;
     YOutBtn.Visible := false;
     PlotTitleEdit.Text := '';
     for i := 1 to NoVariables do
         VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;

procedure TXvsMultYForm.ComputeBtnClick(Sender: TObject);
VAR
  i, j, k, N, NoY, XCol, NoSelecte, result, intvalue, NoSelected : integer;
  YValues, RMatrix : DblDyneMat;
  XValues, Means, Variances, StdDevs : DblDyneVec;
  MinX, MaxX, MinY, MaxY, temp, dblvalue : double;
  cellstring, strvalue, Title : string;
  errorcode : boolean;
  Ncases : integer;
  RowLabels, ColLabels : StrDyneVec;
begin
     NoY := YBox.Items.Count;
     MaxX := -10000;
     MinX := 10000;
     MaxY := -1000;
     MinY := 1000;
     N := 0;
     SetLength(selected,NoY + 1);
     SetLength(RowLabels,NoVariables);
     SetLength(ColLabels,NoVariables);

     for i := 1 to NoVariables do
              if Trim(XEdit.Text) = Trim(OS3MainFrm.DataGrid.Cells[i,0]) then XCol := i;

     for j := 0 to NoY-1 do
         begin
              for i := 1 to NoVariables do
                  if Trim(YBox.Items.Strings[j]) = Trim(OS3MainFrm.DataGrid.Cells[i,0]) then
                    selected[j] := i;
         end;

     selected[NoY] := XCol;
     NoSelected := NoY + 1;
     for i := 0 to NoSelected-1 do
         begin
              RowLabels[i] := Trim(OS3MainFrm.DataGrid.Cells[i+1,0]);
              ColLabels[i] := RowLabels[i];
         end;
     OutPutFrm.RichEdit.Clear;
     OutPutFrm.RichEdit.Lines.Add('X VERSUS MULTIPLE Y VALUES PLOT');
     OutPutFrm.RichEdit.Lines.Add('');
     SetLength(YValues,NoCases+1,NoY+1);
     SetLength(XValues,NoCases+1);
     SetLength(Means,NoSelected+1);
     SetLength(Variances,NoSelected+1);
     SetLength(StdDevs,NoSelected+1);
     SetLength(RMatrix,NoSelected+1,NoSelected+1);
     SetLength(selected,NoVariables);

     for i := 0 to NoSelected - 1 do
         begin
              Means[i] := 0.0;
              StdDevs[i] := 0.0;
              For j := 0 to NoSelected-1 do RMatrix[i,j] := 0.0;
         end;

     for i := 1 to NoCases do
         begin
              if not GoodRecord(i,NoSelected,selected) then continue;
              XValues[i] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[XCol,i]));
              if XValues[i] > MaxX then MaxX := XValues[i];
              if XValues[i] < MinX then MinX := XValues[i];
              for j := 0 to NoY - 1 do
                  begin
                       YValues[i-1,j] := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selected[j],i]));
                       if YValues[i-1,j] > MaxY then MaxY := YValues[i-1,j];
                       if YValues[i-1,j] < MinY then MinY := YValues[i-1,j];
                  end;
         end;

     // get descriptive data
     if DescChk.Checked then
       begin
        Correlations(NoSelected,selected,RMatrix,Means,Variances,StdDevs,errorcode,Ncases);
        N := Ncases;
        Title := 'CORRELATIONS';
        MAT_PRINT(RMatrix,NoSelected,NoSelected,Title,RowLabels,ColLabels,N);
        Title := 'Means';
        DynVectorPrint(Means,NoSelected,Title,RowLabels,N);
        Title := 'Variances';
        DynVectorPrint(Variances,NoSelected,Title,RowLabels,N);
        Title := 'Standard Deviations';
        DynVectorPrint(StdDevs,NoSelected,Title,RowLabels,N);
       end;
     OutPutFrm.ShowModal;

     // sort on X
     for i := 0 to N-2 do
         begin
              for j := i+1 to N-1 do
                  begin
                       if XValues[i] > XValues[j] then // swap
                          begin
                               temp := XValues[i];
                               XValues[i] := XValues[j];
                               XValues[j] := temp;
                               for k := 0 to NoY-1 do
                                   begin
                                        temp := YValues[i,k];
                                        YValues[i,k] := YValues[j,k];
                                        YValues[j,k] := temp;
                                   end;
                          end;
                  end;
         end;
     plotxy(XValues, YValues, MaxX, MinX, MaxY, MinY, N, NoY);

     // clean up
     RMatrix := nil;
     StdDevs := nil;
     Variances := nil;
     Means := nil;
     XValues := nil;
     YValues := nil;
     selected := nil;
     ColLabels := nil;
     RowLabels := nil;
end;

procedure TXvsMultYForm.XInBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := VarList.ItemIndex;
     if index < 0 then exit;
     XEdit.Text := VarList.Items.Strings[index];
     VarList.Items.Delete(index);
     XInBtn.Visible := false;
     XOutBtn.Visible := true;
end;

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

procedure TXvsMultYForm.YInBtnClick(Sender: TObject);
VAR i, index : integer;
begin
     index := VarList.Items.Count;
     i := 0;
     while i < index do
     begin
          if VarList.Selected[i] then
          begin
            YBox.Items.Add(VarList.Items.Strings[i]);
            VarList.Items.Delete(i);
            index := index - 1;
            end
          else i := i + 1;
     end;
     YOutBtn.Visible := true;
end;

procedure TXvsMultYForm.YOutBtnClick(Sender: TObject);
VAR index : integer;
begin
     index := YBox.ItemIndex;
     if index < 0 then exit;
     VarList.Items.Add(YBox.Items.Strings[index]);
     YBox.Items.Delete(index);
     if YBox.Items.Count = 0 then YOutBtn.Visible := false;
end;

procedure TXvsMultYForm.plotxy(XValues : DblDyneVec; YValues : DblDyneMat; MaxX, MinX,
   MaxY, MinY : double; N, NoY : integer);
VAR
   i,j,xpos,ypos,hleft,hright,vtop,vbottom, imagewide : integer;
   vhi, hwide, offset, strhi, imagehi : integer;
   maxval, minval, valincr, Yvalue, Xvalue : double;
   Title : string;
   outline : string;
   Colors : array[0..11] of integer;

begin
     // routine to plot X versus multiple Y values
     BlankFrm.Image1.Canvas.Clear;
     BlankFrm.Show;
     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;
     imagewide := BlankFrm.Image1.Width;
     imagehi := BlankFrm.Image1.Height;
     BlankFrm.Image1.Canvas.FloodFill(0,0,clWhite,fsBorder);
     vtop := 20;
     vbottom := round(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
     BlankFrm.Image1.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 11 do
     begin
          ypos := vbottom;
          Xvalue := minX + valincr * (i - 1);
          xpos := round(hwide * ((Xvalue - minX) / (maxX - minX)));
          xpos := xpos + hleft;
          BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
          ypos := ypos + 10;
          BlankFrm.Image1.Canvas.LineTo(xpos,ypos);
          Title := format('%6.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 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 11 do
     begin
          Title := format('%8.2f',[maxY - ((i-1)*valincr)]);
          strhi := BlankFrm.Image1.Canvas.TextHeight(Title);
          xpos := 10;
          Yvalue := maxY - (valincr * (i-1));
          ypos := round(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];
          BlankFrm.Image1.Canvas.Pen.Color := Colors[j];
          Title := Trim(OS3MainFrm.DataGrid.Cells[selected[j],0]);
          for i := 1 to N do
          begin
               ypos := round(vhi * ( (maxY - YValues[i-1,j]) / (maxY - minY)));
               ypos := ypos + vtop;
               xpos := round(hwide * ( (XValues[i-1]-minX) / (maxX - minX)));
               xpos := xpos + hleft;
               if xpos < hleft then xpos := hleft;
               if i = 1 then BlankFrm.Image1.Canvas.MoveTo(xpos,ypos);
               if LinesBox.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;
          xpos := hwide + hleft;
          BlankFrm.Image1.Canvas.MoveTo(xpos,ypos-strhi);
          BlankFrm.Image1.Canvas.TextOut(xpos,ypos,Title);
     end;
     Title := PlotTitleEdit.Text;
     BlankFrm.Caption := Title;
end;

initialization
  {$I xvsmultyunit.lrs}

end.