unit chaosLIB;

// Strategy Design Pattern & Choice Design Pattern
// Chaos algorithms and Fractals Library for science & finance
// based on chaosMAX released on 1994
// Ex.: with TChaosBase(TModelLorenz.create) do begin
//      setup(frmChaos);
//      Free; end;
// http://max.kleiner.com, max@kleiner.com
//========================================================================

interface

uses
 {$IFDEF LINUX}
  SysUtils, Classes, QForms ;
 {$ELSE}
  SysUtils, Classes, Forms ;
 {$ENDIF}

type

  TChaosBase = class
   private
     cFrm: TForm;
   public
     scaleX1: double;
     scaleX2: double;
     scaleY1: double;
     scaleY2: double;
     procedure setup(vform: TForm); virtual; abstract;
     procedure scaleResults(const X, Y: double;
                             var intX, intY: integer;
                              width, height: integer);
   end;

  TModelLogistic = class(TChaosBase)
    public
      procedure setup(vForm: TForm); override;
    private
      procedure process(var X, Y: double);
    end;

  TModelHenon = class(TChaosBase)
    public
      procedure setup(vForm: TForm); override;
    private
      procedure process(var X, Y: double);
    end;

  TModelLorenz = class(TChaosBase)
    public
      procedure setup(vForm: TForm); override;
    private
      procedure process(var X, Y, Z: double);
    end;

  TModelBifurcation = class(TChaosBase)
    public
      procedure setup(vForm: TForm); override;
    private
      procedure process(var X, Y: double);
    end;

  TModelMandelbrot = class(TChaosBase)
    public
      procedure setup(vForm: TForm); override;
    private
      procedure process(X, Y, au, bu: double;
                          X2, Y2: integer);
    end;


//--------------------------------------------------------------
  // stratety interface
  TFinanzeCharge = class
  public
    function getCharge(const Balance: double): double; virtual; abstract;
  end;

  // Concrete Strategy
  TRegularCharge = class(TFinanzeCharge)
  public
    function getCharge(const Balance: double): double; override;
  end;

  TPreferredCharge = class(TFinanzeCharge)
  public
     function getCharge(const Balance: double): double; override;
  end;

  TTrialCharge = class(TFinanzeCharge)
  public
    function getCharge(const Balance: double): double; override;
  end;

  // Context Interface
  TChargeContext = class
  public
    function ComputeCharges(const Balance: double): double; virtual; abstract;
  end;
  // Concrete Context
  TMonthlyCharges = class(TChargeContext)
  private
    FFinanzeCharge: TFinanzeCharge;
  public
    function ComputeCharges(const Balance: double): double; override;
    constructor Create(aFinanzeCharge: TFinanzeCharge); virtual;
    destructor Destroy; override;
  end;


implementation

uses   QGraphics;      // cause of canvas.pen.color

const     // for finance strategy
  REG_RATE = 0.18;
  PREFERRED_RATE = 0.12;
  TRIAL_RATE = 0.06;

procedure TChaosBase.scaleResults(const X, Y : double;
                             var intX, intY : integer;
                              width, height: integer);
var scaledX, scaledY: double;
  begin
    scaledX:= (X-scaleX1)/(scaleX2-scaleX1);
    scaledY:= (Y-scaleY2)/(scaleY1-scaleY2);
    intX:= round(scaledX * width);
    intY:= round(scaledY * height);
  end;

 procedure TModelLogistic.setup(vForm: TForm);
 var
   i: integer;
   x, y: double;
  begin
    cFrm:= vForm;
    cFrm.Canvas.pen.Color:=clblack;
    scaleX1:=0;
    scaleX2:=1;
    scaleY1:=0;
    scaleY2:=1;
    X:= 0.1; Y:= 0.1;
    for i:= 1 to 5500 do process(X,Y);
  end;

 procedure TModelLogistic.process(var X, Y: double);
 var
   intX, intY : integer;
   dX, dY: double;
 begin
   dY:= X;
   dX:= 4 * X * (1-X);
   scaleResults(X,Y,intX,intY,cFrm.ClientWidth, cFrm.ClientHeight);
  {$IFDEF LINUX}
    cFrm.Canvas.DrawPoint(intX,intY);
  {$ELSE}
   cFrm.Canvas.Pixels[intX, intY]:= clBlack;
  {$ENDIF}
   X:=dX;
   Y:=dY;
 end;

 procedure TModelHenon.setup(vForm: TForm);
 var
   i: integer;
   x, y: double;
  begin
    cFrm:= vForm;
    cFrm.Canvas.pen.Color:=clpurple;
    scaleX1:=-1.1;
    scaleX2:=1.3;
    scaleY1:=0.45;
    scaleY2:=-0.3;
    X:= 0.1;
    Y:= 0.1;
    for i:= 1 to 5500 do process(X,Y);
  end;

 procedure TModelHenon.process(var X, Y: double);
 var
   intX, intY : integer;
   dX, dY: double;
 begin
   dY:= 0.3 * X;
   dX:= Y - 1.4 * X * X + 1;
   intX:= 0;
   intY:= 0;
   scaleResults(X,Y,intX,intY,cFrm.ClientWidth, cFrm.ClientHeight);
  {$IFDEF LINUX}
   cFrm.Canvas.DrawPoint(intX,intY);
  {$ELSE}
   cFrm.Canvas.Pixels[intX, intY]:= clPurple;
  {$ENDIF}
   X:=dX;
   Y:=dY;
 end;


 procedure TModelLorenz.setup(vForm: TForm);
 var
   i: integer;
   x, y, z: double;
  begin
    cFrm:= vForm;
    cFrm.Canvas.pen.Color:=clred;
    scaleX1:=-20;
    scaleX2:=20;
    scaleY1:=-25;
    scaleY2:=30;
    X:= 0.1;
    Y:= 0.1;
    Z:= 0.1;
    for i:= 1 to 6500 do process(X,Y,Z);
  end;

 procedure TModelLorenz.process(var X, Y, Z: double);
 var
   intX, intY : integer;
   dX, dY, dZ: double;
 begin
   dY:= X * (28-Z)-Y;
   dX:= 10 * (Y-X);
   dZ:= X * Y- (8/3) * Z;
   scaleResults(X,Y,intX,intY,cFrm.ClientWidth, cFrm.ClientHeight);
  {$IFDEF LINUX}
   cFrm.Canvas.DrawPoint(intX,intY);
  {$ELSE}
   cFrm.Canvas.Pixels[intX, intY]:= clRed;
  {$ENDIF}
   X:=X+ 0.01 * dX;
   Y:=Y+ 0.01 * dY;
   Z:=Z+ 0.01 * Dz;
 end;

procedure TModelBifurcation.setup(vForm: TForm);
 var
   X, Y: double;
  begin
    X:=1; Y:=1;
    cFrm:= vForm;
    cFrm.Canvas.pen.Color:=clblue;
    process(X,Y);  // direct mode without scaling
 end;

 procedure TModelBifurcation.process(var X, Y: double);
 var
   j, k, i: integer;
   r: double;
 begin
  for i:=0 to 630 do begin   // i and r depends on overflow
    r:=2.95+1.643192e-03*i;
    X:=0.02;
    for j:=1 to 350 do X:=r*X*(1-X);  //accuracy filter
    for k:=1 to 220 do begin
   {$IFDEF LINUX}
    cFrm.Canvas.DrawPoint(i,round(390*(1.0-X)));
   {$ELSE}
    cFrm.Canvas.Pixels[i,round(390*(1.0-X))]:= clBlue;
   {$ENDIF}
    X:=r*X*(1-X);
    end;
  end;
 end;

{ TModelMandelbrot }

procedure TModelMandelbrot.setup(vForm: TForm);
 var
   X1, X2, Y1, Y2, au, ao: integer;
   dX, dY, bo, bu: double;
  begin
    X1:=0;
    X2:=400;
    Y1:=0;
    Y2:=410;
    ao:=1; au:=-2;
    bo:=1.5; bu:= -1.5;
    dX:= (ao-au)/(X2-X1);  //direct scaling cause of speed
    dY:= (bo-bu)/(Y2-Y1);
    cFrm:= vForm;
    process(dX, dY, au,bu, X2, Y2);  //direct mode without scaling
end;


procedure TModelMandelbrot.process(X, Y, au,bu: double;
                                     X2, Y2: integer);
var c1, c2, z1, z2, tmp: double;
   i, j, count: integer;
begin
 c2:= bu;
 for i:= 10 to X2 do begin
   c1:= au;
   for j:= 0 to Y2 do begin
     z1:= 0;
     z2:= 0;
     count:= 0;
     {count is deep of iteration of the mandelbrot set
      if |z| >=2 then z is not a member of a mandelset}
     while (((z1*z1 + z2*z2 <4) AND (count <= 90))) do begin
       tmp:=z1;
       z1:= z1*z1 - z2*z2 + c1;
       z2:= 2*tmp*z2+c2;
       inc(count);
     end;
      //the color-palette depends on TColor(n*count mod t)
    {$IFDEF LINUX}
     cFrm.Canvas.pen.Color:= (16*count mod 255);
     cFrm.Canvas.DrawPoint(j,i);
    {$ELSE}
     cFrm.Canvas.Pixels[j,i]:= (16*count mod 255);
    {$ENDIF}
     c1:=c1 + X;
   end;
  c2:= c2 + Y;
 end;
end;



//--------------------------------------------------------------
// TRegularCharge
function TRegularCharge.getCharge(const Balance: double): double;
begin
  result := Balance * (REG_RATE / 12);
end;

// TPreferredCharge
function TPreferredCharge.getCharge(const Balance: double): double;
begin
  // this could be a complex algorithm that takes into account the
  // credit card holder’s buying patterns and reward points accumulated.
  result := Balance * (PREFERRED_RATE / 12);
end;

// TTrialCharge
function TTrialCharge.getCharge(const Balance: double): double;
begin
  result := Balance * (TRIAL_RATE / 12);
end;

// Concrete Context
constructor TMonthlyCharges.Create(aFinanzeCharge: TFinanzeCharge);
begin
  inherited Create;
  if not assigned(aFinanzeCharge) then
    raise Exception.Create('Missing FinanzeCharge object');
  // this class takes ownership of aFinanzeCharge (will destroy it)
  FFinanzeCharge := aFinanzeCharge;
end;

destructor TMonthlyCharges.Destroy;
begin
  FFinanzeCharge.Free;
  inherited Destroy;
end;

  // context interface seen by client objects
function TMonthlyCharges.ComputeCharges(const Balance: double): double;
begin
  result := FFinanzeCharge.getCharge(Balance);
end;



end.