program ratarr(input,output);
{uses a record to represent a rational as a quotient of
an integer by a positive integer. The procedures here implement
arithmetic and comparison operators}

type posint = 0..maxint;
     rational = array 1..2 of integer;

var R1, R2 , S : rational;

procedure MakeRat( var R :rational);
{initialize R to 0/1}
 begin
   R[1] := 0;
   R[2] := 1
 end;{MakeRat}

procedure ReadRat( var R : rational);
{Trap division by 0}
 var TR : rational;
 begin
   ReadLn(TR[1],TR[2]);
   while TR[2] = 0 do
     begin
      WriteLn('Zero denominator, try again');
      ReadLn(TR[1],TR[2])
     end;
   R := TR
 end;{ReadRat}

procedure WriteRat( var R : rational);
  begin
     Write(R[1], '/', R[2])
  end;{WriteRat}

function Eq( R,S : rational) : boolean;
 begin
   Eq  := (R[1]*S[2] = S[1]*R[2])
 end;

function Gt( R,S : rational) : boolean;
 begin
   Gt := (R[1]*S[2] > S[1]*R[2])
 end;


function Gteq( R,S : rational) : boolean;
 begin
   Gteq := Gt(R,S) or Eq(R,S)
 end;

function Lt( R,S : rational) : boolean;
 begin
   Lt := (R[1]*S[2] < S[1]*R[2])
 end;


function Lteq( R,S : rational) : boolean;
 begin
   Lteq  := Lt(R,S) or Eq(R,S)
 end;

procedure Add( R,S : rational; var T : rational);
{sums rationals using the formula a/b + c/d = (ad + bc)/bd;
 result in T; note this is NOT a function}

begin
  with T do
    begin
      num := R[1]*S[2] + S[1]*R[2];
      denom := R[2]*S[2]
    end{with}
end; {add}

procedure Mi( var R : rational);
{returns -R}
begin
  R[1] := -R[1]
end;

procedure Sub( R,S : rational; var T : rational);
{subtracts rationals using the formula a/b + c/d = a/b + -(c/d)}

begin
  Mi(S);
  Add(R,S,T)
end; {add}

procedure Mult( R,S : rational; var T : rational);
{multiplies rationals using the formula a/b + c/d = (ad + bc)/bd}

begin
  with T do
    begin
      num := R[1]*S[1];
      denom := R[2]*S[2]
    end{with}
end; {mult}

procedure Recip( var R : rational);
{returns 1/R if R<>0 else a message}
var Tmp : integer;
begin
  if R[1] <> 0 then
    begin
      if R[1] < 0 then
       begin
         R[1] := -R[1];
         R[2] := -R[2]
       end{R[1]};
      Tmp := R[1];
      R[1] := R[2];
      R[2] := Tmp
    end{R[1] not 0}
  else
   begin
    WriteRat(R);
    WriteLn(' is zero, has no reciprocal; procedure Recip fails')
   end
end;


procedure DivR( R,S : rational; var T : rational);
{divides rationals using the formula (a/b)/(c/d) = (a/b)*Recip(c/d)}

begin
  MakeRat(T);
  if S[1] <> 0 then
    begin
      Recip(S);
      Mult(R,S,T)
    end{if}
end;{DivR}

begin{main}
{Test the create, reciprocal procs}
  MakeRat(S);
  WriteRat(S);
  WriteLn;
  Recip(S);
  WriteRat(S);
  WriteLn;
  WriteLn('Input first numerator and denominator - positive denominator');
  ReadRat(R1);
  Write(' R1 = ');WriteRat(R1);WriteLn;
{Test unary arith operators}
  Mi(R1);
  Write(' R1 = ');WriteRat(R1);WriteLn;
  Recip(R1);
  Write(' R1 = ');WriteRat(R1);WriteLn;
  WriteLn('Input second numerator and denominator - positive denominator');
  ReadRat(R2);
  Write(' R2 = ');WriteRat(R2);WriteLn;
{Test binary arithmetic operators}
  Add(R1,R2,S);
  Write('The sum is '); WriteRat(S) ;WriteLn;
  Sub(R1,R2,S);
  Write('The difference is '); WriteRat(S) ;WriteLn;
  Mult(R1,R2,S);
  Write('The product is '); WriteRat(S) ;WriteLn;
  DivR(R1,R2,S);
  Write('The quotient is '); WriteRat(S) ;WriteLn;
{Test comparison operators}
  if Eq(R1,R1) then WriteLn('equals ok');
  if not Eq(R1,R2) then WriteLn('R1 <> R2');
  if Gt(R1,R2) then
    WriteLn('R1 > R2')
  else if Lt(R1,R2) then
    Writeln('R1 < R2');
  if Gteq(R1,R2) then
    WriteLn('R1 >= R2')
  else if Lteq(R1,R2) then
    Writeln('R1 <= R2')
end.{main}