lazarus-ccr/applications/lazstats/source/forms/analysis/multivariate/rotateunit.pas

unit RotateUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, StdCtrls, Printers,
  Globals;

type

  { TRotateFrm }

  TRotateFrm = class(TForm)
    Bevel1: TBevel;
    Image1: TImage;
    NextBtn: TButton;
    PrintBtn: TButton;
    ReturnBtn: TButton;
    DegEdit: TEdit;
    Label1: TLabel;
    Panel1: TPanel;
    ScrollBar1: TScrollBar;
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure NextBtnClick(Sender: TObject);
    procedure PrintBtnClick(Sender: TObject);
    procedure ReturnBtnClick(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
  private
    { private declarations }
    Axis1, Axis2 : integer;
    ClWidth, ClHeight, XStart, XEnd, YStart, YEnd : integer;
    Xoffset, Yoffset, XaxisLength, YaxisLength : integer;
    Axis1Pos, Axis2Pos : integer;
    q : DblDyneMat;
    procedure PlotPts(AxisOne, AxisTwo : integer; acolor : TColor; Sender : TObject);
    procedure DrawAxis(Sender : TObject);

  public
    { public declarations }
    Loadings : DblDyneMat;
    NoVars : integer;
    NoRoots : integer;
    RowLabels : StrDyneVec;
    ColLabels : StrDyneVec;
    Order : IntDyneVec;
  end; 

var
  RotateFrm: TRotateFrm;

implementation

uses
  Math;

{ TRotateFrm }

procedure TRotateFrm.ReturnBtnClick(Sender: TObject);
VAR i, j : integer;
begin
     for i := 1 to NoVars do
     BEGIN
          for j := 1 to NoRoots do Loadings[i-1,j-1] := q[i-1,j-1];
     END;
     q := nil;
     Close;
end;

procedure TRotateFrm.ScrollBar1Change(Sender: TObject);
var
   D, A, B : double;
   i, j, l : integer;
   AxisOne, AxisTwo : integer;
begin
     AxisOne := Axis1;
     AxisTwo := Axis2;
     PlotPts(AxisOne,AxisTwo,clWhite,self); // erase previous
     DrawAxis(self);
     for i := 1 to NoVars do
     begin
          for j := 1 to NoRoots do q[i-1,j-1] := Loadings[i-1,j-1];
     end;

     D := ScrollBar1.Position;
     DegEdit.Text := FloatToStr(D);
     D := D / 57.2958; // convert to radians
     for l := 1 to NoVars do
     BEGIN
          A := sin(D);
          B := cos(D);
          q[l-1,AxisOne-1] := Loadings[l-1,AxisOne-1] * B - Loadings[l-1,AxisTwo-1] * A;
          q[l-1,AxisTwo-1] := Loadings[l-1,AxisOne-1] * A + Loadings[l-1,AxisTwo-1] * B;
     END;

     PlotPts(AxisOne,AxisTwo,clBlack,self); // plot new
end;

procedure TRotateFrm.FormActivate(Sender: TObject);
var
  w: Integer;
begin
  w := MaxValue([NextBtn.Width, PrintBtn.Width, ReturnBtn.Width]);
  NextBtn.Constraints.MinWidth := w;
  PrintBtn.Constraints.MinWidth := w;
  ReturnBtn.Constraints.MinWidth := w;
end;

procedure TRotateFrm.FormShow(Sender: TObject);
VAR i, j : integer;
begin
     if NoRoots < 2 then
     begin
          ShowMessage('ERROR! Only 1 factor-exiting');
          exit;
     end;
     SetLength(q,NoVars,NoVars);
     for i := 1 to NoVars do
     begin
          for j := 1 to NoRoots do q[i-1,j-1] := Loadings[i-1,j-1];
     end;
     ClWidth := Image1.Width;
     ClHeight := Image1.Height;
     XOffset := ClWidth div 10;
     YOffset := ClHeight div 10;
     XStart := Xoffset;
     XEnd := ClWidth - XOffset;
     XAxisLength := XEnd - XStart;
     YStart := ClHeight - YOffset;
     YEnd := YOffset;
     YAxisLength := YStart - YEnd;
     Image1.Canvas.Brush.Color := clWhite;
     Image1.Canvas.Pen.Color := clBlack;
     Image1.Canvas.Rectangle(0,0,ClWidth,ClHeight);
     Axis1 := 1;
     Axis2 := 2;
     Axis2Pos := XAxisLength div 2 + XStart; // position of y axis from left
     Axis1Pos := YAxisLength div 2 + YEnd; // position of X axis from top
     ScrollBar1.Position := 0;
     DrawAxis(self);
     PlotPts(Axis1, Axis2, clBlack, self);
end;

procedure TRotateFrm.NextBtnClick(Sender: TObject);
VAR i, j : integer;
begin
     if (Axis2 = NoRoots) and (Axis1 = NoRoots-1) then
     begin
          ShowMessage('ALL DONE! All pairs completed.');
          exit;
     end;
     PlotPts(Axis1,Axis2,clWhite,self);
     for i := 1 to NoVars do
     BEGIN
          for j := 1 to NoRoots do Loadings[i-1,j-1] := q[i-1,j-1];
     END;

     Axis2 := Axis2 + 1;
     if Axis2 <= NoRoots then
     begin
          ScrollBar1.Position := 0;
          DrawAxis(self);
          PlotPts(Axis1,Axis2,clBlack,self);
          exit;
     end;
     Axis1 := Axis1 + 1;
     Axis2 := Axis1 + 1;
     if Axis2 > NoRoots then exit;
     ScrollBar1.Position := 0;
     DrawAxis(self);
     PlotPts(Axis1,Axis2,clBlack,self);
end;

procedure TRotateFrm.PrintBtnClick(Sender: TObject);
var r : Trect;
begin
        with Printer do
        begin
                Printer.Orientation := poPortrait;
                r := Rect(20,20,printer.pagewidth-20,printer.pageheight div 2 + 20);
                BeginDoc;
                Canvas.StretchDraw(r,Image1.Picture.BitMap);
                EndDoc;
        end;
end;

procedure TRotateFrm.PlotPts(AxisOne, AxisTwo: integer; acolor: TColor;
  Sender: TObject);
var i, xpos, ypos, xmid, ymid, size : integer;
begin
     xmid := Axis2Pos;
     ymid := Axis1Pos;
     Image1.Canvas.Pen.Color := acolor;
//     if color <> clWhite then size := 2 else size := 4;
     size := 4;
     for i := 1 to NoVars do
     begin
          if q[i-1,AxisOne-1] >= 0 then  // positive x value
          begin
               xpos := round(q[i-1,AxisOne-1] * (XAxisLength div 2));
               xpos := xpos + xmid;
          end
          else // negative x value (factor 1)
          begin
               xpos := round(abs(q[i-1,AxisOne-1]) * (XAxisLength div 2));
               xpos := xmid - xpos;
          end;
          if q[i-1,AxisTwo-1] >= 0 then // positive y value (factor 2)
          begin
               ypos := round(q[i-1,AxisTwo-1] * (YAxisLength div 2));
               ypos := ymid - ypos;
          end
          else  // negative y factor loading
          begin
               ypos := round(abs(q[i-1,AxisTwo-1]) * (YAxisLength div 2));
               ypos := ymid + ypos;
          end;

          Image1.Canvas.Ellipse(xpos-size,ypos-size,xpos+size,Ypos+size);
     end;
     DrawAxis(self);
end;

procedure TRotateFrm.DrawAxis(Sender: TObject);
var
   i, xincr, yincr, TextLong : integer;
   step : double;
   Title : string;
begin
     xincr := XAxisLength div 10;
     yincr := YAxisLength div 10;

     // draw X axis
     Image1.Canvas.MoveTo(XOffset,Axis1Pos);
     Image1.Canvas.LineTo(XEnd,Axis1Pos);
     Title := 'Factor ' + IntToStr(Axis1);
     Image1.Canvas.TextOut(0,Axis1Pos,Title);
     step := -1.0;
     for i := 0 to 10 do
     begin
          Title := format('%4.1f',[step]);
          Image1.Canvas.TextOut(XOffset+xincr*i,Axis1Pos+2,Title);
          step := step + 0.2;
     end;
     // draw Y axis
     Image1.Canvas.MoveTo(Axis2Pos,YEnd);
     Image1.Canvas.LineTo(Axis2Pos,YStart);
     Title := 'Factor ' + IntToStr(Axis2);
     Image1.Canvas.TextOut(Axis2Pos,0,Title);
     step := -1.0;
     for i := 0 to 10 do
     begin
          Title := format('%4.1f',[step]);
          TextLong := Image1.Canvas.TextWidth(Title);
          Image1.Canvas.TextOut(Axis2Pos-TextLong,YStart-(i*yincr),Title);
          step := step + 0.2;
     end;
end;


initialization
  {$I rotateunit.lrs}

end.