unit math2sub;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}

(***************************************)
(* Copyright (C) 2013, SHIRAISHI Kazuo *)
(***************************************)


interface
const degree:extended=180./pi;
var
   ln2,ln10:extended;


function cosh(x:double):double;
function sinh(x:double):double;
function tanh(x:double):double;
function sindeg(x:double):double;
function cosdeg(x:double):double;
function tandeg(x:double):double;
function cotdeg(x:double):double;
function secdeg(x:double):double;
function cscdeg(x:double):double;
function deg(x:double):double;
function rad(x:double):double;
function asinsub(x,h,j:extended):extended;
function acossub(x,h,j:extended):extended;
function asin(x:double):double;
function acos(x:double):double;
function angle(x,y:double):double;
function ANGLEdeg(x,y:double):double;
function random50:double;
function random52:double;
procedure InitSeed;
procedure MyRandomize;
procedure MyRandomize2(t:double);
function MyTime:double;
function mydate:double;

implementation
uses SysUtils,
     base,base2,mt19937;

const
    c360:double=360;
    c180:double=180;
    c90 :double= 90;


function cosh(x:double):double;
begin
   cosh:=(exp(x)+exp(-x))/2.0
end;

function sinh(x:double):double;
var
   k,i:integer;
   t,t0,s,x1,x2:extended;
begin
    if abs(x)>=1e-1 then
           sinh:=(exp(x)-exp(-x))/2
    else
       begin
           x2:=x*x;
           t:=x;
           s:=x;
           k:=1;
           repeat
             t0:=t;
             s:=s*x2;
             inc(k);
             i:=k;
             inc(k);
             i:=i*k;
             s:=s/i;
             t:=t+s;
           until t=t0;
           sinh:=t;
       end;
end;

function tanh(x:double):double;
begin
   if x>=1000.0 then
      tanh:=1.0
   else if x<=-1000.0 then
      tanh:=-1.0
   else
      tanh:=sinh(x)/cosh(x);
end;


const pi2:extended=2*pi;
      pihalf:extended=pi/2;
      piquar:extended=pi/4;


function sindeg(x:double):double;
begin
    if x<0 then
                 sindeg:=-sindeg(-x)
    else if x>=c360 then
                 sindeg:=sindeg(x-int(x/c360) * c360)
    else if x>c90 then
                 sindeg:=sindeg(c180-x)
    else
                 sindeg:=system.sin(x/degree)
end;

function cosdeg(x:double):double;
begin
    cosdeg:=sindeg(x+c90)
end;


function tandeg(x:double):double;
begin
    tandeg:=sindeg(x)/cosdeg(x);
end;



function cotdeg(x:double):double;
begin
    cotdeg:=cosdeg(x)/sindeg(x);
end;




function secdeg(x:double):double;
begin
   secdeg:=1/cosdeg(x);
end;

function cscdeg(x:double):double;
begin
   cscdeg:=1/sindeg(x);
end;


function deg(x:double):double;
begin
    deg:=x*(180/pi);
end;


function rad(x:double):double;
begin
    rad:=x*(pi/180)
end;

function asinsub(x,h,j:extended):extended;
                   { h=1-x,j=1+x}
begin
   if h=0 then
        asinsub:=pi/2
   else if j=0 then
        asinsub:=-pi/2
   else if (h>0) and (j>0) then
        asinsub:=arctan(x/sqrt(h*j))
   else
       begin
          asinsub:=0;
          setexceptionwith('ASIN',3007);
      end;
 end;

function acossub(x,h,j:extended):extended;
                    { h=1-x,j=1+x}

begin
  if h>=0.1 then
        acossub:=pi/2-asinsub(x,h,j)
  else if h>=0 then
     begin
        //j:=1+x;
        acossub:=arctan(sqrt(h*j)/x);
     end
  else
     begin
          setexceptionwith('ACOS',3007);
          acossub:=0;
     end;
end;


function asin(x:double):double;
begin
     asin:=asinsub(x,1-x,1+x)
end;

function acos(x:double):double;
begin
     acos:=acossub(x,1-x,1+x)
end;



function angle(x,y:double):double;
begin
    if x>0 then
          angle:=arctan(y/x)
    else if (x<0) and (y>0) then
          angle:=arctan(y/x)+pi
    else if (x<0) and (y<>0) then
          angle:=arctan(y/x)-pi
    else if (x<0) and (y=0) then
          angle:=pi
    else if (x=0) and (y>0) then
          angle:=pi/2
    else if (x=0) and (y<0) then
          angle:=-pi/2
    else
         setexceptionwith('ANGLE',3008);
end;

function ANGLEdeg(x,y:double):double;
begin
    result:=angle(x,y)*degree
end;



{***********}
{Date & Time}
{***********}

const
    DaysOfMonth:array[1..12] of word =(31,28,31,30,31,30,31,31,30,31,30,31);

function mydate:double;
var
   y,m,d,w:word;
   leap:boolean;
   i:integer;
begin
   setFPUmask(originalCW);

   decodedate(date,y,m,d);
   leap:= (y mod 4 = 0) and((y mod 100 <>0) or (y mod 400=0))  ;
   y:=y mod 100;
   for i:=1 to m-1 do d:=d+daysofmonth[i];
   if (m>2) and leap then inc(d);
   mydate:=longint(1000)*y +d;

   setFPUMask(controlword);
end;


function MyTime:double;
var
   t:double;
begin
   setFPUmask(originalCW);

   t:=time;
   t:=t-INT(t);
   result:=(t*8640000)/100;

   setFPUMask(controlword);

end;

{**************}
{Random Numbers}
{**************}
var
   RNDCriticalSection:TRtlCriticalSection;

function random53:double; //resolution 53bit
begin
  EnterCriticalSection(RNDCriticalSection);
  result:=((Int64(genrand_int32 shr 5) shl 26)+(genrand_int32 shr 6))
           *(1.0/9007199254740992.0);
  LeaveCriticalSection(RNDCriticalSection);
end;

function random52:double; //resolution 52bit
begin
  EnterCriticalSection(RNDCriticalSection);
  result:=((Int64(genrand_int32 shr 5) shl 25)+(genrand_int32 shr 7))
           *(1.0/4503599627370496.0);
  LeaveCriticalSection(RNDCriticalSection);
end;

function random50:double; //resolution 50bit
begin
  EnterCriticalSection(RNDCriticalSection);
  result:=((Int64(genrand_int32 shr 5) shl 23)+(genrand_int32 shr 9))
           *(1.0/1125899906842624.0);
  LeaveCriticalSection(RNDCriticalSection);
end;

procedure InitSeed;
begin
  init_genrand(19650218);
end;

procedure MyRandomize;
var
  x:double;
begin
    x:=MyDate;
    x:=x-1000*int(x/1000);
    init_genrand(System.round((x*86400+mytime)*100)+1);
    x:=random50;    //乱数を1個捨てる
end;


procedure MyRandomize2(t:double);
var
   c:cardinal;
begin
   try
      c:=System.Trunc(t);
      init_genrand(c);
   except
   end;
end;



initialization
   ln2:=ln(2);
   ln10:=ln(10);
   InitCriticalSection(RNDCriticalSection);
finalization
   DoneCriticalSection(RNDCriticalSection);
end.
