unit mathc;

{$MODE objfpc}
{$INLINE ON}
(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)

{$X+}

interface


type
    Complex=record
      x:double ;
      y:double ;
    end;

    PComplex=^Complex;


Operator := (r : double) z : Complex; inline;
Operator := (x : complex) z : double; inline;

Operator + (x : double; y : complex) z : complex; inline;
Operator + (x : complex; y : double) z : complex; inline;
Operator + (x,y : complex) z : complex;           inline;
Operator - (x,y : complex) z : complex;           inline;
Operator - (x : double; y : complex) z : complex; inline;
Operator - (x : complex; y : double) z : complex; inline;
Operator - (x : complex) z : complex;             inline;
Operator * (x : double; y : complex) z : complex; inline;
Operator * (x : complex; y : double) z : complex; inline;
Operator * (x,y : complex) z : complex;           inline;
Operator / (x : double; y : complex) z : complex;
Operator / (x : complex; y : double) z : complex; inline;
Operator / (x,y : complex) z : complex;

operator = (x : double; y : complex) b : boolean;  inline;
operator = (x : complex; y : double) b : boolean;  inline;
operator = (x, y : complex) b : boolean;           inline;
operator < (x : double; y : complex) b : boolean;  inline;
operator < (x : complex; y : double) b : boolean;  inline;
operator < (x, y : complex) b : boolean;           inline;
operator <= (x : double; y : complex) b : boolean; inline;
operator <= (x : complex; y : double) b : boolean; inline;
operator <= (x, y : complex) b : boolean;          inline;
operator > (x : double; y : complex) b : boolean;  inline;
operator > (x : complex; y : double) b : boolean;  inline;
operator > (x, y : complex) b : boolean;           inline;
operator >= (x : double; y : complex) b : boolean; inline;
operator >= (x : complex; y : double) b : boolean; inline;
operator >= (x, y : complex) b : boolean;          inline;

function testreal(const z : complex): double;      overload;
function testreal(x : double) : double     inline; overload;

function CMPLX(x,y:double):complex; overload;          inline;
function CMPLX(x:double; y:complex):complex; overload; inline;
function CMPLX(x:complex; y:double):complex; overload; inline;
function CMPLX(x,y:complex):complex; overload;         inline;

function CSqr(x:double ):double; overload;      inline;
function CSqr(x:Complex):Complex; overload;      inline;

function COpo(x:double ):double; overload;      inline;
function COpo(x:Complex):Complex; overload;      inline;
function CAdd(x,y:double ):double;  overload;    inline;
function CAdd(x,y:complex):Complex; overload;    inline;
function CAdd(x:double; y:complex):Complex; overload;    inline;
function CAdd(x:complex; y:double):Complex; overload;    inline;
function CSub(x,y:double ):double;  overload;    inline;
function CSub(x,y:complex):Complex; overload;    inline;
function CSub(x:double; y:complex):Complex; overload;    inline;
function CSub(x:complex; y:double):Complex; overload;    inline;
function CMul(x,y:double ):double;  overload;    inline;
function CMul(x,y:complex):Complex; overload;    inline;
function CMul(x:double; y:complex):Complex; overload;    inline;
function CMul(x:complex; y:double):Complex; overload;    inline;
function CDiv(x,y:double ):double;  overload;    inline;
function CDiv(x,y:complex):Complex; overload;    inline;
function CDiv(x:double; y:complex):Complex; overload;    inline;
function CDiv(x:complex; y:double):Complex; overload;    inline;


function ARG(z:complex):double;                        inline;
function ARGDEG(z:complex):double;                     inline;
function CONJ(z:complex):complex;                      inline;
function RE(z:complex):double;                         inline;
function IM(z:complex):double;                         inline;
function ABS(z:complex):double;overload;               inline;
function EXP(z:complex):complex;
function LOG(z:complex):complex;

function CStr(x:complex):AnsiString;

function NumericVariable(var x:complex; a:complex):PComplex; inline; overload;
function NumericVariable(var x:complex; a:double):PComplex; inline; overload;


type
  PExtComplex=^ExtComplex;        //現在，未使用
  ExtComplex=packed object
      x:extended ;
      y:extended ;
      procedure init(a,b:extended);
      procedure initC(c:complex);
      procedure add(p:PExtComplex);
      procedure multiply(p:PExtComplex);
      procedure divide(p:PExtComplex);
      procedure subtract(p:PExtComplex);
      procedure oppose;
      procedure square;
      procedure inverse;
      function iszero:boolean;
      procedure GetC(var c:complex);
    end;

procedure setExceptionNonReal;

implementation
uses
     base,sconsts,math2sub,arithmet;

procedure setExceptionNonReal;
begin
   SetexceptionWith(s_ImaginaryNotAvailable,1000)
end;



operator := (r : double) z : Complex;
begin
  z.x:=r;
  z.y:=0.0;
end;

Operator := (x : complex) z : double;
begin
   z:=x.x;
   if x.y<>0 then  setExceptionNonReal;
end;

Operator + (x,y : complex) z : complex;
begin
 z.x:=x.x+y.x;
 z.y:=x.y+y.y;
end;

Operator + (x : double; y : complex) z : complex;
begin
  z.x:=x + y.x;
  z.y:=    y.y;
end;

Operator + (x : complex; y : double) z : complex;
begin
  z.x:=x.x+y;
  z.y:=x.y;
end;

Operator - (x : complex) z : complex;
begin
  z.x:=-x.x;
  z.y:=-x.y;
end;

Operator - (x,y : complex) z : complex;
begin
 z.x:=x.x-y.x;
 z.y:=x.y-y.y;
end;

Operator - (x : double; y : complex) z : complex;
begin
  z.x:=x - y.x;
  z.y:=  - y.y;
end;

Operator - (x : complex; y : double) z : complex;
begin
  z.x:=x.x-y;
  z.y:=x.y;
end;

Operator * (x,y : complex) z : complex;
begin
  z.x:=extended(x.x) * y.x - extended(x.y) * y.y;
  z.y:=extended(x.x) * y.y + extended(x.y) * y.x;
end;

Operator * (x : double; y : complex) z : complex;
begin
  z.x:=x * y.x;
  z.y:=x * y.y;
end;

Operator * (x : complex; y : double) z : complex;
begin
  z.x:=x.x * y;
  z.y:=x.y * y;
end;

Operator / (x,y : complex) z : complex;
var
  n:extended;
begin
   n:= system.sqr(y.x) + system.sqr(y.y);
   if n=0 then begin setexception(3001); exit end;
   z.x:=(extended(x.x) * y.x + extended(x.y) * y.y)/n;
   z.y:=(extended(x.y) * y.x - extended(x.x) * y.y)/n;       ;
end;

Operator / (x : double; y : complex) z : complex;
var
  n:extended;
begin
   n:= system.sqr(y.x) + system.sqr(y.y);
   if n=0 then begin setexception(3001); exit end;
  z.x:=(extended(x)*y.x)/n;
  z.y:=(-extended(x)*y.y)/n;
end;

Operator / (x : complex; y : double) z : complex;
begin
  z.x:=x.x / y;
  z.y:=x.y / y;
end;

operator = (x : double; y : complex) b : boolean;
begin
  b:= ( x = y.x ) and ( y.y = 0 );
end;

operator = (x : complex; y : double) b : boolean;
begin
  b:= ( x.x = y ) and ( x.y = 0);
end;

operator = (x, y : complex) b : boolean;
begin
  b:= (x.x = y.x) and (x.y = y.y) ;
end;

operator < (x : double; y : complex) b : boolean;
begin
  b:=  x < y.x ;
  if y.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator < (x : complex; y : double) b : boolean;
begin
  b:=  x.x < y ;
  if x.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator < (x, y : complex) b : boolean;
begin
  b:=  x.x < y.x ;
  if (x.y<>0) or (y.y<>0) then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator <= (x : double; y : complex) b : boolean;
begin
  b:=  x <= y.x ;
  if y.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator <= (x : complex; y : double) b : boolean;
begin
  b:=  x.x <= y ;
  if x.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator <= (x, y : complex) b : boolean;
begin
  b:=  x.x <= y.x ;
  if (x.y<>0) or (y.y<>0) then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator > (x : double; y : complex) b : boolean;
begin
  b:=  x > y.x ;
  if y.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator > (x : complex; y : double) b : boolean;
begin
  b:=  x.x > y ;
  if x.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator > (x, y : complex) b : boolean;
begin
  b:=  x.x > y.x ;
  if (x.y<>0) or (y.y<>0) then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator >= (x : double; y : complex) b : boolean;
begin
  b:=  x >= y.x ;
  if y.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator >= (x : complex; y : double) b : boolean;
begin
  b:=  x.x >= y ;
  if x.y<>0 then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

operator >= (x, y : complex) b : boolean;
begin
  b:=  x.x >= y.x ;
  if (x.y<>0) or (y.y<>0) then  setexceptionwith(s_ImaginaryInComparable,3000);
end;

function testreal(const z : complex) : double;   overload;
begin
   testreal:=z.x;
   if z.y<>0 then  setExceptionNonReal;
end;

function testreal(x : double) : double;           inline; overload;
begin
  testreal:=x
end;

function CMPLX(x,y:double):complex; overload;
begin
   result.x:=x;
   result.y:=y;
end;

function CMPLX(x:double; y:complex):complex;  overload;
begin
   result:=CMPLX(x,testreal(y))
end;

function CMPLX(x:complex; y:double):complex; overload;
begin
  result:=CMPLX(testreal(x), y)
end;

function CMPLX(x,y:complex):complex; overload;
begin
  result:=CMPLX(testreal(x), testreal(y))
end;

function ARG(z:complex):double;
begin
  result:=angle(z.x, z.y);
end;

function ARGDEG(z:complex):double;
begin
  result:=AngleDeg(z.x, z.y);
end;

function CONJ(z:complex):complex;
begin
   result.x:= z.x;
   result.y:=-z.y;
end;

function RE(z:complex):double;
begin
   result:=z.x
end;

function IM(z:complex):double;
begin
   result:=z.y
end;

function ABS(z:complex):double;overload;
begin
   result:=sqrt(sqr(z.x)+sqr(z.y));
end;

function EXP(z:complex):complex;
var
    e:extended;
begin
    e:=system.exp(z.x);
    result.x:=e*cos(z.y);
    result.y:=e*sin(z.y);
end;

function LOG(z:complex):complex;
begin
  if (z.y=0) and (z.x>0) then
    begin
     result.y:=0;
     result.x:=ln(z.x)
    end
  else
    begin
      result.x:=ln(ABS(z));
      result.y:=ARG(z);
    end;
end;

function CSqr(x:double ):double; overload;      inline;
begin
   result:=sqr(x)
end;

function CSqr(x:Complex):Complex; overload;      inline;
begin
   CSqr.x:= sqr(x.x)-sqr(x.y);
   CSqr.y:=2*x.x * x.y;
end;

function COpo(x:double ):double; overload;      inline;
begin
  COpo:=-x;
end;
function COpo(x:Complex):Complex; overload;      inline;
begin
  COpo:=-x;
end;

function CAdd(x,y:double ):double;  overload;    inline;
begin
 CAdd:= x + y
end;
function CAdd(x,y:complex):Complex; overload;    inline;
begin
 CAdd:= x + y
end;
function CAdd(x:double; y:complex):Complex; overload;    inline;
begin
 CAdd:= x + y
end;
function CAdd(x:complex; y:double):Complex; overload;    inline;
begin
 CAdd:= x + y
end;

function CSub(x,y:double ):double;  overload;    inline;
begin
  CSub:= x - y
end;
function CSub(x,y:complex):Complex; overload;    inline;
begin
  CSub:= x - y
end;
function CSub(x:double; y:complex):Complex; overload;    inline;
begin
  CSub:= x - y
end;
function CSub(x:complex; y:double):Complex; overload;    inline;
begin
  CSub:= x - y
end;

function CMul(x,y:double ):double; overload;    inline;
begin
   CMul := x * y
end;
function CMul(x,y:complex):Complex; overload;    inline;
begin
   CMul := x * y
end;
function CMul(x:double; y:complex):Complex; overload;    inline;
begin
   CMul := x * y
end;
function CMul(x:complex; y:double):Complex; overload;    inline;
begin
   CMul := x * y
end;

function CDiv(x,y:double ):double;  overload;    inline;
begin
   CDiv := x / y
end;
function CDiv(x,y:complex):Complex; overload;    inline;
begin
   CDiv := x / y
end;
function CDiv(x:double; y:complex):Complex; overload;    inline;
begin
   CDiv := x / y
end;
function CDiv(x:complex; y:double):Complex; overload;    inline;
begin
   CDiv := x / y
end;


function CStr(x:complex):AnsiString;
var
  n:number;
begin
    convert(x.x,n);
    result:=Dstr(n);
    if x.y<>0 then
    begin
       convert(x.y,n);
       result:='(' + result +' '+ DStr(n) + ')';
    end;
end;

function NumericVariable(var x:complex; a:complex):PComplex; inline; overload;
begin
   x:=a;
   result:=@x
end;

function NumericVariable(var x:complex; a:double):PComplex; inline; overload;
begin
   x:=a;
   result:=@x
end;

{**********}
{ExtComplex}
{**********}

procedure ExtComplex.init(a,b:extended);
begin
    x:=a; y:=b
end;

procedure ExtComplex.initC(c:complex);
begin
   x:=c.x; y:=c.y
end;

procedure ExtComplex.add(p:PExtComplex);
begin
  x:=x+p^.x; y:=y+p^.y
end;

procedure ExtComplex.subtract(p:PExtComplex);
begin
  x:=x-p^.x;
  y:=y-p^.y;
end;

{$IFDEF CPUX86_64}
procedure ExtComplex.multiply(p:PExtComplex);
var
  tx,ty:extended;
begin
  tx:=x * p^.x - y * p^.y;
  ty:=x * p^.y + y * p^.x;
  x:=tx;
  y:=ty
end;

procedure ExtComplex.divide(p:PExtComplex);
var
  d,tx,ty:extended;
begin
  d:=sqr(p^.x) + sqr(p^.y);
  tx:=(x * p^.x + y * p^.y)/d;
  ty:=(y * p^.x - x * p^.y)/d;
  x:=tx;
  y:=ty
end;

procedure  ExtComplex.square;
var tx,ty:extended;
Begin
   tx:=sqr(x)-sqr(y);
   ty:=2*x*y;
   x:=tx;
   y:=ty
end;

procedure ExtComplex.inverse;
var
    d:extended;
begin
    d:=sqr(x)+sqr(y);
    x:=x/d;
    y:=-y/d;
end;
{$ELSE}

{$ASMMODE Intel}
procedure ExtComplex.multiply(p:PExtComplex);assembler;
asm
   fld tbyte ptr [eax]      //x.x
   fld tbyte ptr [eax+$0A]  //x.y
   fld tbyte ptr [edx]      //y.x
   fld tbyte ptr [edx+$0A]  //y.y
   fld  st(3)              // x.x
   fmul st,st(1)           // x.x*y.y
   fld  st(3)              // x.y
   fmul st,st(3)           // x.y*y.x
   fadd                    // x.x*y.y+x.y*y.x
   fstp tbyte ptr [eax+$0A]
   fmulp st(2),st          // x.y*y.y
   fmulp st(2),st          // x.x*y.x
   fsub                    // x.x*y.x-x.y*y.y
   fstp tbyte ptr [eax]
   wait
end;

procedure ExtComplex.divide(p:PExtComplex);assembler;
asm
   fld tbyte ptr [eax]      //x.x
   fld tbyte ptr [eax+$0A]  //x.y
   fld tbyte ptr [edx]      //y.x
   fld tbyte ptr [edx+$0A]  //y.y
   fld st(1)               //y.x
   fmul st,st(0)           //y.x^2
   fld st(1)               //y.y
   fmul st,st(0)           //y.y^2
   fadd                    //y.x^2+y.y^2
   fdiv  st(2),st          // y.x←y.x/(y.x^2+y.y^2)
   fdivp st(1),st          // y.y←y.y/(y.x^2+y.y^2)
   fld  st(2)              // x.y
   fmul st,st(2)           // x.y*y.x
   fld  st(4)              // x.x
   fmul st,st(2)           // x.x*y.y
   fsub                    // x.y*y.x-x.x*y.y
   fstp tbyte ptr [eax+$0A]
   fmulp st(2),st          // x.y*y.y
   fmulp st(2),st          // x.x*y.x
   fadd                    // x.x*y.x+x.y*y.y
   fstp tbyte ptr [eax]
   wait
 end;

procedure ExtComplex.square;assembler;
asm
   fld tbyte ptr [eax]      //x.x
   fld tbyte ptr [eax+$0A]  //x.y
   fld  st(1)              // x.x
   fmul st,st(0)           // x.x^2
   fld  st(1)              // x.y
   fmul st,st(0)           // x.y^2
   fsub                    // x.x^2-x.y^2
   fstp tbyte ptr [eax]
   fmulp st(1),st          // x.x*x.y
   fadd st,st(0)           // 2*x.x*x.y
   fstp tbyte ptr [eax+$0A]
   wait
 end;

procedure ExtComplex.inverse;assembler;
asm
   fld tbyte ptr [eax]     //x
   fld tbyte ptr [eax+$0A] //y
   fld  st(1)              // x
   fmul st,st(0)           // x^2
   fld  st(1)              // y
   fmul st,st(0)           // y^2
   faddp st(1),st          // x^2+y^2
   fdiv  st(2),st          // x←x/(x^2+y^2)
   fdivp st(1),st          // y←y/(x^2+y^2)
   fchs                    // y←-y/(x^2+y^2)
   fstp tbyte ptr [eax+$0A]
   fstp tbyte ptr [eax]
   wait
 end;
{$ENDIF}


procedure ExtComplex.oppose;
begin
  x:=-x;
  y:=-y
end;

function ExtComplex.iszero:boolean;
begin
  result:=(x=0) and (y=0)
end;

procedure ExtComplex.GetC(var c:complex);
begin
  c.x:=x; c.y:=y
end;

end.

