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

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


interface
uses SysUtils,
     arithmet;

procedure InitRational;

const
  maxnumlen=maxint div 16 {in dwords};

type
  bignum = record
    len:integer;        { in dwords}
    num:array[0..maxnumlen] of Cardinal;   {the last elememt is a overflow buffer.}
  end;
  Pbignum = ^bignum;

type
   numertype=(AnInteger, AFraction);
   PNumeric = ^numeric;
   numeric = object
      function size:integer;
      function newCopy:PNumeric;
      function NewCopyOpposite:Pnumeric;
      procedure getN(Var n:number);
      procedure getF(var x:double);
      procedure getX(var x:extended);
      procedure getLongInt(var i:LongInt; var c:integer);
      function isInteger:boolean;
      function sign:shortint;
      function isZero:boolean;
     private
      sgn:shortint;
      typ:NumerType;
      filler:smallint;
      //filler:array[1..3] of byte;
      con:array[0..maxnumlen] of cardinal;
      //con1:array[0..maxnumlen] of cardinal;
      procedure resolve(var nmr,dnm:Pbignum);
      function newcopywithsign(sn:shortint):PNumeric;
    end;

procedure DisposeNumeric(var p:Pnumeric);
//function NewRational(sgn:shortint;nmr,dnm:Pbignum):PNumeric;
function newRationalLongint(a:longint):PNumeric;
function NewRationalFromNumber(const n:PNumber):PNumeric;

procedure add(a,b:PNumeric; var x:PNumeric);
procedure sbt(a,b:PNumeric; var x:PNumeric);
procedure mlt(a,b:PNumeric; var x:PNumeric);
procedure qtt(a,b:PNumeric; var x:PNumeric);
function compare(a,b:PNumeric):shortint;
procedure opposite(var r:PNumeric);
procedure oppose(var r:PNumeric);
procedure absolute(var r:PNumeric);
procedure sgn(var r:PNumeric);
procedure intpart(var r:PNumeric);
procedure fractpart(var r:PNumeric);
procedure intround(var r:PNumeric);
procedure ceil(var r:PNumeric);
procedure BasicInt(var r:PNumeric);
procedure BasicMod( a,b:PNumeric; var x:PNumeric);
procedure BasicRemainder( a,b:PNumeric; var x:PNumeric);
procedure min( a,b:PNumeric; var x:PNumeric);
procedure max( a,b:PNumeric; var x:PNumeric);
procedure IntSQR(var p:PNumeric);
procedure IntLOG2(var p:PNumeric);
procedure numer(var r:PNumeric);
procedure denom(var r:PNumeric);
procedure gcd(a,b:PNumeric; var x:PNumeric);

function strFraction(p:Pnumeric):string;

const RToNOverflow=-1012;
var
   ConstHalf,ConstOne,ConstZero,ConstTwo,ConstTen {,ConstMaxNum}:PNumeric;
var
   constPI:PNumeric;

implementation
uses
     base,vstack;


function neg(a:shortint):shortint;
begin
end;


procedure clearBuf(p:Pbignum; s:integer);
var
  i:integer;
begin
  with p^ do
     begin
       len:=s;
       if s>0 then for i:=0 to s-1 do num[i]:=0;
     end;
end;

{***********}
{ addition  }
{subtraction}
{***********}
function CompareBigNum(a,b:PBigNum):integer;
begin
end;


procedure shrink(x:PBigNum);  {  shrink length }
var i:integer;
begin
    i:=x^.len-1;
    while (i>=0) and (x^.num[i]=0) do dec(i);
    x^.len:=i+1;
end;


procedure  AddBuf(buf:PbigNum; a:PBigNum);
begin
end;

procedure  sbtBuf(buf:PBigNum; s:PBigNum);
begin

end;


{*************}
{Multipliction}
{*************}
procedure MultiSub(a,b:cardinal; var i:cardinal);
begin
end;

procedure Multiply( x:PBigNum; a,b:PBigNUm);
var
  lenA,lenB,i,k:integer;
begin
  lenA:=a^.len;
  lenB:=b^.len;
  clearBuf(x,lenA+lenB);
  for k:=0 to LenA+LenB-2 do
   for i:=base.max(0,k-lenB+1) to base.min(lenA-1,k) do
      MultiSub( a^.num[i], b^.num[k-i], x^.num[k]);
  shrink(x);
end;


{********}
{Division}
{********}

procedure setword(p:Pbignum; n:cardinal);
begin
    if n=0 then
             p^.len:=0
    else begin
             p^.len:=1;
             p^.num[0]:=n;
         end
end;

procedure paste( a:PBignum; x:PBignum);
begin
   {x:=a} { the domain of x must be obtained previously,larger than that of a.}
   move(a^,x^,((a^.len)+1)*sizeOf(Cardinal));
end;

procedure  MulWord(x:PBigNum; a:PBigNum; n:cardinal );
begin
end;

{********}
{division}
{********}
procedure divideShort(q,r:PBignum; a:PBignum; b:cardinal);
begin
end;

function Canshiftsbt(buf:PBigNum; s:PBigNum; shift:integer):boolean;
begin
end;

procedure  shiftsbt(buf:PBigNum; s:PBigNum; shift:integer);
   {subtract s*(2^32)^shift from buf}
      {only for case of lenBuf>=lenS+shift & buf>=s*(2^32)^shift}
           {buf:=buf-a*(2^32)^shift}
begin
end;


procedure DivideLong(q,r:PBigNum; a,b:PBigNum );
begin
end;

procedure Divide(q,r:PBigNum; a,b:PBigNum );
begin
  case b^.len of
    0: SetException(3001);
    1: if (b.num[0]=1) then
          begin
            paste(a,q);
            r^.len:=0;
          end
       else
         DivideShort(q,r,a,b.num[0]);
    else DivideLong(q,r,a,b);
  end;
end;

procedure abbreviate(nmr,dnm:PBignum);

var
   a,b,q,r:PBigNum;
   t:PBigNum;
   MemSize:integer;
   len0:integer;
begin
   if dnm=nil then exit;
   if nmr^.len=0 then setword(dnm,1)
   else
     begin
       len0:=base.max(nmr^.len, dnm^.len)+1;
       MemSize:=(len0 *4 +5)*sizeof(cardinal);
       a:=GetMemory(MemSize);
       b:=@a.num[len0];
       q:=@b.num[len0];
       r:=@q.num[len0];
       paste(nmr,a);
       paste(dnm,b);
       divide(q,r,a,b);
       while r^.len>0 do
          begin
              t:=r;
              r:=a;
              a:=b;
              b:=t;
              divide(q,r,a,b);
          end;
        // b<==GCD(nmr,dnm)
        divide(q,r,nmr,b); paste(q,nmr);
        divide(q,r,dnm,b); paste(q,dnm);
        FreeMemory(MemSize);
     end
end;

{****}
{ISQR}
{****}
procedure shiftLeft(var x:bignum);
begin
end;

procedure shiftRightsub(var x:bignum);
begin
end;

procedure shiftRight(var x:bignum);    //x:=x/2
begin
  shiftRightSub(x);
  shrink(@x)
end;

procedure ISQR(var x:bignum);
var
   s,ss,t,r:PBigNum;
   MemSize:integer;
begin
   if x.len=0 then exit;

   MemSize:=(x.len *4 +9)*sizeOf(Cardinal);
   s:=GetMemory(MemSize);
   ss:=@s.num[x.len+1];
   t:=@ss.num[x.len+1];
   r:=@t.num[x.len+1];
   setword(s,1);
   paste (@x,t);
   while not CanShiftSbt(s,t,0) do
     begin
        shiftLeft(s^);
        shiftRight(t^);
     end;
   repeat
     paste(s,t);
     divide(ss,r,@x,s);
     AddBuf(ss,s);
     shiftright(ss^);
     paste(ss,s);
   until canShiftSbt(s,t,0);
   paste(t,@x);
   FreeMemory(MemSize);
end;

{*******************}
{Convert to extended}
{*******************}

function ConvLong(p:pointer; var e:integer):extended;
begin
end;

function ConvShort( p:pointer; var e:integer):extended;
begin
end;

function ExtendedV(n:PBignum):extended;
begin
end;

{****************}
{ Number of bits }
{****************}
function ILOG2(n:PBigNum):longint;
var
   i,j:longint;
   x:Cardinal;
begin
 with n^ do
   begin
     i:=(len - 1) * 8 * sizeof(Cardinal);
     x:=num[len-1];
   end;
 j:=8 * sizeof(Cardinal) - 1;
 while (j>0) and (longint(x)>0) do
    begin
       x:=x shl 1;
       dec(j)
    end;
  result:=i+j;
end;



{********************}
{ numerical variables}
{********************}

function Numeric.size:integer;
begin
   if @self=nil then
     result:=0
   else if typ=AnInteger then
     result:=(con[0]+2)*sizeof(cardinal)
   else
     result:=(con[0]+con[con[0]+1] +3 )*sizeof(cardinal);
end;

procedure DisposeNumeric(var p:Pnumeric);
begin
end;

function NewRationalAnInteger(sgn:shortint; nmr:Pbignum):PNumeric;
begin
end;

function NewRationalDirect(sgn:shortint; nmr,dnm:Pbignum):PNumeric;
                //nmr^とdnm^は既約でなければならない。
begin

end;

function NewRational(sgn:shortint;nmr,dnm:Pbignum):PNumeric;
var
    x,y:PBigNum;
    MemSize:integer;
begin
    MemSize:=(nmr^.len + dnm^.len +2)*sizeOf(cardinal);
    x:=GetMemory(MemSize);
    y:=@x^.num[nmr^.len];
    paste(nmr,x);
    paste(dnm,y);
    abbreviate(x,y);
    newrational:=NewRationalDirect(sgn,x,y);
    FreeMemory(MemSize);
end;

type
   ShortBigNum = record
                       len:integer;
                       num:cardinal;
                 end;

function newRationalLongint(a:longint):PNumeric;
var
   x:ShortBigNum;
begin
   if a=0 then
      result:=nil
   else if a>0 then
      begin
         x.len:=1; x.num:=a;
         result:=NewRationalAnInteger(1,PBigNum(@x))
      end
   else
      begin
         x.len:=1; x.num:=-a;
         result:=NewRationalAnInteger(-1,PBigNum(@x))
      end;
end;


function Numeric.newcopywithsign(sn:shortint):PNumeric;
var
   bytes:integer;
begin

end;

function  Numeric.newCopy:PNumeric;

begin
end;

function Numeric.NewCopyOpposite:Pnumeric;
begin
    NewCopyOpposite:=newcopywithsign(-sign)
end;

const NumberBase:ShortBigNum=(len:1; num:1000000000);
const ConstBigNum1: ShortBigNum = (len:1; num:1);

procedure BigNumToNumber(p:PBigNum; var n:number);

begin
end;

procedure Numeric.resolve(var nmr,dnm:Pbignum);
          //@self<>nilを仮定する
begin
    nmr:=@con[0];
    if typ=AnInteger then
       dnm:=nil
    else
       dnm:=@con[con[0] + 1];
end;

procedure Numeric.GetN(var n:number);

begin
end;


procedure Numeric.getF(var x:double);
var
  y:extended;
begin
  getX(y);
  x:=y
end;


procedure Numeric.getX(var x:extended);
var
   nmr,dnm:PBigNum;
begin
   if @self=nil then
      x:=0.
   else
      begin
        resolve(nmr,dnm);
        if dnm=nil then
           x:=extendedv(nmr)
        else
           x:=extendedv(nmr)/extendedv(dnm);
        if sgn<0 then
           x:=-x;
      end;
end;

procedure Numeric.getLongInt(var i:longint; var c:integer);
var
   r:PNumeric;
begin
  i:=0;c:=0;
  if @self=nil then exit;

  if isinteger then
       begin
         if (con[0]=1) and (LongInt(con[1])>=0) then
         begin
            i:=con[1];
            if sgn<0 then i:=-i;
         end
         else
         c:=sgn;
       end
      else
       begin
         r:=newcopy;
         intround(r);
         r^.getLongInt(i,c);
         disposeNumeric(r);
       end;
end;

function Numeric.isInteger:boolean;
begin
  if @self=nil then
    result:=true
  else
    result:=(typ=AnInteger)
end;

function Numeric.sign:shortint;
begin
   if @self=nil then
      result:=0
   else
      result:=sgn
end;

function addabs(p,q:PNumeric; sgn:shortint):PNumeric;
var
   a,b,c,d:PBigNum;
   x,y:PBigNum;
   MemSize,adbc:integer;
begin
   p^.resolve(a,b);
   q^.resolve(c,d);

   if (b=nil) and (d=nil) then
     begin
       MemSize:=(base.max(a^.len,c^.len) +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       paste(a,x);
       AddBuf(x,c);
       addabs:=newrationalAnInteger(sgn,x);
       FreeMemory(MemSize);
     end
   else if b=nil then
     begin
       adbc:=base.max(a^.len+d^.len, c^.len)+1;
       MemSize:=(adbc + 2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       multiply(x,a,d);
       AddBuf(x,c);
       addabs:=newrationalDirect(sgn,x,d);
       FreeMemory(MemSize);
     end
   else if d=nil then
       addabs:=addabs(q,p,sgn)
   else
     begin
       adbc:=base.max(a^.len + d^.len , b^.len + c^.len) +1;
       MemSize:=(adbc + b^.len + base.max(c^.len, d^.len) +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       y:=@x.num[adbc];
       multiply(x,a,d);
       multiply(y,c,b);
       AddBuf(x,y);
       multiply(y,b,d);
       abbreviate(x,y);
       addabs:=newrationalDirect(sgn,x,y);
       FreeMemory(MemSize);
     end;
end;

function sbtabs(p,q:PNumeric; sgn:shortint):PNumeric;
var
   a,b,c,d:PBigNum;
   x,y:PBigNum;
   t:PBigNum;
   MemSize,xsize:integer;
   s:integer;
begin
   p^.resolve(a,b);
   q^.resolve(c,d);

   if (b=nil) and (d=nil) then
     begin
       s:=CompareBignum(a,c);
       if s=0 then
          result:=nil
       else
          begin
            if s<0 then
                   begin  t:=a;  a:=c;  c:=t; sgn:=-sgn end;
            MemSize:=(a^.len +2 )*sizeOf(cardinal);
            x:=GetMemory(MemSize);
             paste(a,x);
             SbtBuf(x,c);
             shrink(x);
             if x^.len=0 then
                result:=nil
             else
                result:=newrationalAnInteger(sgn,x);
             FreeMemory(MemSize);
         end
     end
   else if b=nil then
     begin
       xsize:=a^.len + d^.len +1;
       MemSize:=(xsize + base.max( c^.len,  d^.len) +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       y:=@x.num[xsize];
       multiply(x,a,d);
       paste(c,y);
       s:=CompareBigNum(x,y);
       if s=0 then
          result:=nil
       else
          begin
             if s<0 then
                   begin t:=x; x:=y; y:=t; sgn:=-sgn end;
             SbtBuf(x,y);
             shrink(x);
             if x^.len=0 then
                result:=nil
             else
                result:=newrationalDirect(sgn,x,d);
          end;
       FreeMemory(MemSize)
     end
   else if d=nil then
     begin
       result:=sbtabs(q,p,-sgn)
     end
   else
     begin
       xsize:=base.max(a^.len , b^.len ) + d^.len +1;
       MemSize:=(xsize +b^.len +base.max( c^.len,  d^.len) +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       y:=@x.num[xsize];
       multiply(x,a,d);
       multiply(y,c,b);
       s:=CompareBigNum(x,y);
       if s=0 then
          result:=nil
       else
          begin
             if s<0 then
                   begin t:=x; x:=y; y:=t; sgn:=-sgn end;
             SbtBuf(x,y);
             shrink(x);
             multiply(y,b,d);
             abbreviate(x,y);
             if x^.len=0 then
                result:=nil
             else
                result:=newrationalDirect(sgn,x,y);
          end;
       FreeMemory(MemSize)
     end;
end;


function sbtwithSign(a,b:PNUmeric ; sgnA,sgnB:shortint):PNUmeric ;forward;

function addwithSign(a,b:PNumeric ; sgnA,sgnB:shortint):PNumeric ;
begin
   if sgnA=0 then addwithSign:=b^.newcopywithsign(sgnB)
      else if sgnB=0 then addwithSign:=a^.newcopywithsign(sgnA)
          else if sgnA = sgnB then addwithSign:=addabs(a,b,sgnA)
                  else addwithSign:=sbtwithSign(a,b,sgnA,neg(sgnB))
end;


function sbtwithSign(a,b:PNumeric ; sgnA,sgnB:shortint):PNumeric ;
begin
   if sgnA=sgnB then
                    sbtwithSign:=sbtAbs(a,b,sgnA)
                else
                    sbtwithSign:=addwithSign(a,b,sgnA,neg(sgnB));
end;

function addrational(a,b:PNumeric):Pnumeric;
begin
  addrational:=addwithSign(a,b,a^.sgn,b^.sgn);
end;

function sbtrational(a,b:PNumeric):Pnumeric;
begin
  sbtrational:=sbtwithSign(a,b,a^.sgn,b^.sgn);
end;


{************************************}
{rational multiplication and division}
{************************************}

function multiplyrational(p,q:Pnumeric):Pnumeric;
var
   a,b,c,d:PBignum;
   a1,b1,c1,d1,x,y:PBigNum;
   MemSize:integer;
begin
   p^.resolve(a,b);
   q^.resolve(c,d);

   if (b=nil) and (d=nil) then
     begin
       MemSize:=(a^.len + c^.len +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       multiply(x,a,c);
       MultiplyRational:=newrationalAnInteger((p^.sgn)*(q^.sgn),x);
       FreeMemory(MemSize);
     end
   else if b=nil then
     begin
       MemSize:=(a^.len *2 + c^.len + d^.len + 4)*sizeOf(cardinal);
       a1:=getMemory(MemSize);
       d1:=@a1.num[a^.len];
       x:=@d1.num[d^.len];
       paste(a,a1);
       paste(d,d1);
       abbreviate(a1,d1);
       multiply(x,a1,c);
       multiplyrational:=newrationalDirect((p^.sgn)*(q^.sgn),x,d1);
       FreeMemory(MemSize)
     end
   else if d=nil then
       result:=MultiplyRational(q,p)
   else
     begin
       MemSize:=((a^.len + b^.len + c^.len + d^.len)*2 + 7)*sizeOf(cardinal);
       a1:=getMemory(MemSize);
       b1:=@a1.num[a^.len];
       c1:=@b1.num[b^.len];
       d1:=@c1.num[c^.len];
       x:=@d1.num[d^.len];
       y:=@x.num[a^.len+c.len];
       paste(a,a1);
       paste(b,b1);
       paste(c,c1);
       paste(d,d1);
       abbreviate(a1,d1);
       abbreviate(c1,b1);
       multiply(x,a1,c1);
       multiply(y,b1,d1);
       multiplyrational:=newrationalDirect((p^.sgn)*(q^.sgn),x,y);
       FreeMemory(MemSize)
     end;
end;

function divideRational(p,q:PNumeric):Pnumeric;
var
   a,b,c,d:PBigNum;
   x,y,z:PBigNUm;
   qinv:PNumeric;
   MemSize:integer;
begin
   p^.resolve(a,b);
   q^.resolve(c,d);
   if c^.len=0 then  SetException(3001) ;

   if (b=nil) and (d=nil) then
     begin
       MemSize:=(a^.len + c^.len +2 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       y:=@x.num[a^.len];
       paste(a,x);
       paste(c,y);
       abbreviate(x,y);
       DivideRational:=newrationalDirect((p^.sgn)*(q^.sgn),x,y);
       FreeMemory(MemSize);
     end
   else if d=nil then
     begin
       MemSize:=(a^.len + b^.len + c^.len *2  + 4 )*sizeOf(cardinal);
       x:=GetMemory(MemSize);
       y:=@x.num[a^.len];
       z:=@y.num[c^.len];
       paste(a,x);
       paste(c,y);
       abbreviate(x,y);
       multiply(z,b,y);
       DivideRational:=newrationalDirect((p^.sgn)*(q^.sgn),x,z);
       FreeMemory(MemSize);
     end
   else
     begin
       MemSize:=(c^.len + d^.len + 3)*sizeOf(cardinal);
       qinv:=GetMemory(memSize);
       qinv^.sgn:=q^.sgn;
       x:=@qinv.con[0];
       paste(d,x);
       y:=@x.num[x^.len];
       if (c^.len=1) and (c^.num[0]=1) then
           qinv.typ:=AnInteger
       else
         begin
           qinv.typ:=AFraction;
           paste(c,y);
         end;
       result:=MultiplyRational(p,qinv);
       FreeMemory(memSize);
     end;
end;

function IntegerPartRational(p:Pnumeric):PNumeric;
var
  q,r:PBigNum;
  nmr,dnm:PBigNum;
  MemSize:integer;
begin
   if p^.isInteger then
           begin result:=p^.newCopy; exit end;

   p^.resolve(nmr,dnm);
   MemSize:=(nmr^.len *2 +3)*sizeof(cardinal);
   r:=getMemory(MemSize);
   q:=@r.num[nmr^.len +1];
   divide(q,r,nmr,dnm);
   IntegerPartRational:=newRationalAnInteger(p^.sgn,q);
   FreeMemory(memSize)
end;

function decimalpartRational(p:PNumeric):Pnumeric;
var
  q,r:PBignum;
  nmr,dnm:PBignum;
  MemSize:integer;
begin
   p^.resolve(nmr,dnm);
   if dnm=nil then
              begin result:=nil; exit end;

   MemSize:=(nmr^.len *2 +3)*sizeof(cardinal);
   r:=getMemory(MemSize);
   q:=@r.num[nmr^.len +1];
   divide(q,r,nmr,dnm);
   DecimalPartRational:=newRational(p^.sgn,r,dnm);
   FreeMemory(memSize)
end;

{Arithmetic Routines}

procedure add(a,b:PNumeric; var x:PNumeric);
                            // xは初期化済変数でなければならない(nilでもよい)
var
  p:PNumeric;
begin
  if a=nil then
         if b=nil then
            p:=nil
         else
            p:=b^.newCopy
  else
         if b=nil then
            p:=a^.newcopy
         else
            p:=addRational(a,b);

  disposeNumeric(x);
  x:=p;
end;

procedure sbt(a,b:PNumeric; var x:PNumeric);
var
  p:PNumeric;
begin
  if a=nil then
      if b=nil then
         p:=nil
      else
         p:=b^.newCopyOpposite
  else
      if b=nil then
          p:=a^.newcopy
      else
          p:=sbtRational(a,b);
  disposeNumeric(x);
  x:=p;
end;

procedure mlt(a,b:PNumeric; var x:PNumeric);
var
  p:PNumeric;
begin
  if (a=nil) or (b=nil) then
        p:=nil
  else
        p:=MultiplyRational(a,b);
  disposeNumeric(x);
  x:=p;
end;

procedure qtt(a,b:PNumeric; var x:PNumeric);
var
  p:PNumeric;
begin
  if b=nil then
       setexception(3001)
  else
     begin
       if a=nil then
           p:=nil
       else
           p:=DivideRational(a,b);
       disposeNumeric(x);
       x:=p;
     end;
end;

function CompareSub(a,b:PNumeric):shortint;
var
   a1,a2,b1,b2:PBigNum;
   MemSize,MemSize2:integer;
   x,y:PBignum;
begin
   a^.resolve(a1,a2);
   b^.resolve(b1,b2);
   if b2=nil then
     begin
       MemSize:=0;
       x:=a1
     end
   else
     begin
       MemSize:=(a1^.len + b2^.len +4)*sizeOf(Cardinal);
       x:=GetMemory(memSize);
       multiply(x,a1,b2);
     end;
   if a2=nil then
      y:=b1
   else
      begin
       memSize2:=(a2^.len + b1^.len +4)*sizeOf(Cardinal);
       y:=GetMemory(MemSize2);
       multiply(y,a2,b1);
       memSize:=memSize+Memsize2;
      end;
   result:=compareBignum(x,y);
   if a^.sgn<0 then result:=-result;
    FreeMemory(MemSize)

end;

function compare(a,b:PNumeric):shortint;
begin
  if b^.isZero then
     result:=a^.sign
  else if a^.isZero then
     result:= - b^.sign
  else if a^.sgn=b^.sgn then
     begin
       if a^.isInteger and b^.isInteger then
          begin
            result:=compareBignum(@a^.con[0], @b^.con[0]);
            if a^.sgn<0 then result:=-result
          end
       else
          result:=CompareSub(a,b)
     end
  else if a^.sgn>b^.sgn then
     result:=1
  else
     result:=-1
end;

function Numeric.isZero:boolean;
begin
   result:=(@self=nil) or (self.sgn=0) ;
end;

procedure opposite(var r:PNumeric);
begin
  oppose(r)
end;

procedure oppose(var r:PNumeric);
begin
   if r<>nil then with r^ do sgn:=-sgn
end;

procedure absolute(var r:PNumeric);
begin
   if r<>nil then with r^ do if sgn<>0 then sgn:=1;
end;

procedure sgn(var r:PNumeric);
var
  q:PNumeric;
begin
   if (r=nil) or (r^.sgn=0) then
       q:=ConstZero.newCopy
   else
       q:=NewRationalLongint(r^.sgn);
   disposeNumeric(r);
   r:=q;
end;

procedure intpart(var r:PNumeric);
var
   p:PNumeric;
begin
  if r^.isInteger then
  else
    begin
       p:=IntegerPartRational(r);
       disposeNumeric(r);
       r:=p;
    end;
end;

procedure fractpart(var r:PNumeric);
var
   p:PNumeric;
begin
   if r<>nil then
   begin
       p:=DecimalPartRational(r);
       disposeNumeric(r);
       r:=p;
   end;
end;

procedure intround(var r:PNumeric);
begin
  if r^.isInteger then
  else
    begin
      add(r,ConstHalf,r);
      BasicInt(r);
    end;
end;

procedure BasicInt(var r:PNumeric);
begin
  if r^.isInteger then
  else
     if r^.sgn>0 then
        Intpart(r)
     else
        begin
          oppose(r);
          ceil(r);
          oppose(r);
        end;
end;

procedure ceil(var r:PNumeric);
begin
  if r^.isInteger then
  else
     if r^.sgn>0 then
        begin
          Intpart(r);
          add(r,ConstOne,r)
        end
     else
        begin
          oppose(r);
          BasicInt(r);
          oppose(r);
        end;
end;


procedure BasicMod(a,b:PNumeric; var x:PNumeric);
var
   a1,a2,b1,b2:PBignum;
   MemSize,len0:integer;
   q,r:PBignum;
   t:PNumeric;
begin
  t:=nil;
  if b^.isZero then
      begin
         disposeNumeric(x);
         setexception(3006)
      end
  else if a^.isZero then
     begin
       disposeNumeric(x);
       x:=nil
     end
  else if a^.isInteger and b^.isInteger then
     begin
         a^.resolve(a1,a2);
         b^.resolve(b1,b2);
         len0:=base.max(a1^.len , b1^.len)+1;
         MemSize:=(2*len0 + 2)*SizeOf(Cardinal);
         r:=GetMemory(MemSize);
         q:=@r^.num[len0];
         divide(q,r,a1,b1);
         if r.len=0 then
             t:=nil
         else if a^.sign=b^.sign then
             t:=newrationalDirect(b^.sign, r, PBignum(@ConstBignum1))
         else
            begin
               paste(b1,q);
               shiftsbt(q,r,0);
               shrink(q);
               t:=newrationalDirect(b^.sign, q, PBignum(@ConstBignum1))
            end;
         disposeNumeric(x);
         x:=t;
         FreeMemory(MemSize);
     end
  else
     begin
        qtt(a,b,t);
        BasicInt(t);
        mlt(b,t,t);
        sbt(a,t,x);
        disposeNumeric(t);
     end;
end;


procedure BasicRemainder(a,b:PNumeric; var x:PNumeric);
var
   a1,a2,b1,b2:PBignum;
   MemSize,len0:integer;
   q,r:PBignum;
   t:PNumeric;
begin
  t:=nil;
  if b^.isZero then
      begin
         disposeNumeric(x);
         setexception(3006)
      end
  else if a^.isZero then
     begin
       disposeNumeric(x);
       x:=nil
     end
  else if a^.isInteger and b^.isInteger then
    begin
       a^.resolve(a1,a2);
       b^.resolve(b1,b2);
       len0:=base.max(a1^.len , b1^.len)+1;
       MemSize:=(2*len0 + 2)*SizeOf(Cardinal);
       r:=GetMemory(MemSize);
       q:=@r^.num[len0];
       divide(q,r,a1,b1);
       if r.len=0 then
           t:=nil
       else
           t:=newrationalDirect(a^.sign, r, PBignum(@ConstBignum1));
       disposeNumeric(x);
       x:=t;
       FreeMemory(MemSize);
     end
   else
     begin
        qtt(a,b,t);
        IntPart(t);
        mlt(b,t,t);
        sbt(a,t,x);
        disposeNumeric(t);
     end;
end;

procedure min(a,b:PNumeric; var x:PNumeric);
var
    r:PNumeric;
begin
     if compare(a,b)<=0 then r:=a^.newcopy else r:=b^.newcopy;
     disposeNumeric(x);
     x:=r;
end;

procedure max(a,b:PNumeric; var x:PNumeric);
var
    r:PNumeric;
begin
     if compare(a,b)>=0 then r:=a^.newcopy else r:=b^.newcopy;
     disposeNumeric(x);
     x:=r;
end;

procedure GCD(a,b:PNumeric; var x:PNumeric);
var
   a1,a2,b1,b2:PBignum;
   aa,bb,qq,rr,tt:PBignum;
   MemSize,len0:integer;
   a0,b0,t:PNumeric;
begin
  t:=nil;
  if b^.isZero then
     if a^.isZero then
          setexception(3006)
     else
       begin
         t:=a^.newcopywithsign(1);
         disposeNumeric(x);
         x:=t;
       end
  else if a^.isZero then
     begin
       t:=b^.newcopywithsign(1);
       disposeNumeric(x);
       x:=t;
     end
  else if a^.isInteger and b^.isInteger then
    begin
       a^.resolve(a1,a2);
       b^.resolve(b1,b2);
       len0:=base.max(a1^.len , b1^.len)+1;
       MemSize:=(len0 *4 +5)*sizeof(cardinal);
       aa:=GetMemory(MemSize);
       bb:=@aa.num[len0];
       qq:=@bb.num[len0];
       rr:=@qq.num[len0];
       paste(a1,aa);
       paste(b1,bb);
       divide(qq,rr,aa,bb);
       while rr^.len>0 do
          begin
              tt:=rr;
              rr:=aa;
              aa:=bb;
              bb:=tt;
              divide(qq,rr,aa,bb);
          end;
        // bb<==GCD(a1,b1)
       t:=newrationalDirect(1,bb,PBignum(@ConstBignum1));
       disposeNumeric(x);
       x:=t;
       FreeMemory(MemSize);
     end
   else
     begin
        a0:=a^.newcopywithsign(1);
        b0:=b^.newcopywithsign(1);
        t:=nil;
        repeat
          basicremainder(a0,b0,t);
          disposeNumeric(a0);
          a0:=b0;
          b0:=t;
          t:=nil;
        until b0^.isZero;
        disposeNumeric(x);
        x:=a0;
        disposeNumeric(b0);
     end;
end;


procedure IntSQR(var p:PNumeric);
var
   nmr,dnm:PBigNum;
   x:PBigNum;
   MemSize:integer;
   q:PNumeric;
begin
   if p=nil then exit;
   if p^.sgn<0 then setexception(3005);

   IntPart(p);
   if p^.isZero then exit;

   p^.resolve(nmr,dnm);
   MemSize:=(nmr^.len+2)*SizeOf(Cardinal);
   x:=Getmemory(memSize);
   paste(nmr,x);
   ISQR(x^);
   shrink(x);
   q:=newRationalAnInteger(p^.sgn,x);
   disposeNumeric(p);
   p:=q;
   freeMemory(memsize)
end;

procedure IntLOG2(var p:PNumeric);
var
   nmr,dnm:PBigNum;
   x:PBigNum;
   MemSize:integer;
   q:PNumeric;
begin
   IntPart(p);
   if (p=nil) or (p^.sgn<=0) then setexception(3004);

   p^.resolve(nmr,dnm);
   MemSize:=(nmr^.len+2)*SizeOf(Cardinal);
   q:=newRationalLongInt(ILOG2(nmr));
   disposeNumeric(p);
   p:=q;
end;

procedure numer(var r:PNumeric);
var
  p:PNumeric;
  nmr,dnm:PBignum;
begin
  if r=nil then exit;
  r^.resolve(nmr,dnm);
  p:=NewRationalAnInteger(1,nmr);
  disposeNumeric(r);
  r:=p;
end;

procedure denom(var r:PNumeric);
var
  p:PNumeric;
  nmr,dnm:PBignum;
begin
  if r=nil then
     p:=ConstOne^.NewCopy
  else
     begin
        r^.resolve(nmr,dnm);
        if dnm<>nil then
          p:=NewRationalAnInteger(1,dnm)
        else
          p:=ConstOne^.NewCopy;
     end;
  disposeNumeric(r);
  r:=p;
end;

{******************}
{convert to strings}
{******************}
type string9=string[9];

procedure StrDword(n:cardinal; var c:PChar);
var
  i:integer;
begin
  for i:=1 to 9 do
     begin
        dec(c);
        c^:=chr((n mod 10) + ord('0') );
        n:=n div 10;
     end;
end;


function strBig(x:Pbignum):string;
var
  a,q,r:PBigNum;
  MemSize:integer;
  c:PChar;
begin
  if x^.len=0 then begin result:='0' ; exit end;

  memSize:=(x^.len *3 +4)*sizeOf(cardinal) + x^.len *10 +4;
  q:=GetMemory(MemSize);
  a:=@q.num[x^.len];
  r:=@a.num[x^.len];
  c:=@r.num[x^.len];
  c:=c+(x^.len*10);
  c^:=chr(0);
  paste(x,a);
  result:='';
  repeat
     divideShort(q,r,a,1000000000);
     StrDword(r.num[0],c);
     paste(q,a);
  until (a^.len=0) ;
  while c^='0' do inc(c);
  result:=c;
  FreeMemory(MemSize);
end;

function strFraction(p:Pnumeric):string;
var
  nmr,dnm:PBignum;
  s:string;
begin
  if p=nil then
     result:=' 0'
  else
  begin
    p^.resolve(nmr,dnm);
    s:= strBig(nmr) ;
    if p^.sgn=-1 then s:='-' +s else s:=' ' + s;
    if dnm=nil then
       strFraction:=s
    else
       strFraction:=s + '/' + strBig(dnm);
  end
end;

function newRationalword(m,n:cardinal):PNumeric;
                        // 使用注意
begin

end;


function NewRationalFromNumber(const n:PNumber):PNumeric;

begin
end;

procedure InitRational;
begin
   ConstHalf:=newRationalWord(1,2);
   ConstOne:=newRationalLongint(1);
   ConstZero:=nil; //NewRationalWord(0,1);
   ConstTwo:=NewRationalLongint(2);
   ConstTen:=NewRationalLongint(10);
   constPi:=nil; 
end;

end.
