Unit Raciona5;

Interface

  Uses  Crt, Aritunit;

  Type
      Tort    = Record
                 szamlalo,
                 nevezo: EgeszSzam;
                End;
      ValosSzam= Record
                   egesz, tort: EgeszSzam
                 End;

  Var
      NullaTort,Fel,
      EgyTort,KettoTort : Tort;
      Kerekites         : Boolean;

  Procedure Lnko (Var a, b, oszto, a1, b1 : EgeszSzam);
  Procedure Tortosszead (Var a, b, osszeg : Tort);
  Procedure Tortkivon (Var a, b, kulonbseg : Tort);
  Procedure Tortszoroz (Var a, b, Szorzat : Tort);
  Procedure Tortoszt (Var a, b, Hanyados : Tort);
  Function  Egyenlo (Var a,b: EgeszSzam): Boolean;
  Procedure Egeszbol_Tort(Var szamlalo,nevezo: EgeszSzam; Var rac: Tort);
  Procedure Becsul(Var a : Tort; hossz : PontossagTipus);
  Procedure Konv_RacVal(Var valos: ValosSzam; {Var} racionalis: Tort);
  Procedure ValosKiir(valos: ValosSzam);

Implementation

  Procedure Becsul(Var a : Tort; hossz : PontossagTipus);
    Var i, k : integer;
  Begin
    k:=a.szamlalo.hossz;
    if a.nevezo.hossz>k then k:=a.nevezo.hossz;
    if k>hossz then
      begin
        for i:=0 to hossz do
        begin
          a.szamlalo.jegy[i]:=a.szamlalo.jegy[i-hossz+k];
          a.nevezo.jegy[i]:=a.nevezo.jegy[i-hossz+k];
        end;
        a.szamlalo.hossz:=a.szamlalo.hossz-k+hossz;
        a.nevezo.hossz:=a.nevezo.hossz-k+hossz;
      end;
  end;

  Procedure Egeszbol_Tort(Var szamlalo,nevezo: EgeszSzam; Var rac: Tort);
  Begin
    rac.szamlalo:=szamlalo; rac.nevezo:=nevezo
  End; { Egeszbol_Tort }

  Function Egyenlo (Var a,b: EgeszSzam): Boolean;
    var i    : 0 .. MaxPontossag;
        igaz : Boolean;
  begin
    i:=0;
    igaz:=false;
    if a.hossz=b.hossz then
    begin
      while (a.jegy[i]=b.jegy[i]) and (i < a.hossz) do
        i:=i+1;
      igaz:=a.jegy[i]=b.jegy[i];
    end;
    egyenlo:=igaz;
  end;

  Procedure Lnko (var a, b, oszto, a1, b1 : EgeszSzam);
      Var
         seged,c : EgeszSzam;
  begin
    a1:=a;
    b1:=b;
    While (not Nulla_e(a1)) and (not Nulla_e(b1)) do
      If Nagyobb(a1,b1) Then
        begin
          Oszt(a1,b1,c,seged);
          a1:=seged
        end
      else
        begin
          Oszt(b1,a1,c,seged);
          b1:=seged
        end;
    if Nulla_e(a1) then
      oszto:=b1
    else
      oszto:=a1;
    if egyenlo(oszto, egy) then
      begin
      a1:=a;
      b1:=b;
      end
    else
      begin
      oszt(a,oszto,a1,seged);
      oszt(b,oszto,b1,seged);
      end;
  end;

  Procedure Egyszerusit(Var a,b,c,d,szamlalo,nevezo: EgeszSzam);
    Var
       i,k : integer;
  begin
        if not nagyobb(b,d) then
          begin
          k:=d.hossz;
          nevezo.hossz:=MaxPontossag;
          szamlalo.hossz:=a.hossz+b.hossz-k-1;
          if not egyenlo(nulla,b) then szamlalo.hossz:=szamlalo.hossz+1;
          end
        else
          begin
          k:=b.hossz;
          szamlalo.hossz:=MaxPontossag;
          nevezo.hossz:=c.hossz+d.hossz-k-1;
          if not egyenlo(nulla,d) then nevezo.hossz:=nevezo.hossz+1;
          end;
        For i:=k+1 to MaxPontossag do
          begin
          szamlalo.jegy[i-k-1]:=a.jegy[i];
          nevezo.jegy[i-k-1]:=c.jegy[i];
          end;
        for i:=0 to k do
          begin
          szamlalo.jegy[i+MaxPontossag-k]:=b.jegy[i];
          nevezo.jegy[i+MaxPontossag-k]:=d.jegy[i];
          end;
        Szamlalo.szamrendszer:=b.szamrendszer;
        Szamlalo.elojel:=b.Elojel;
        Nevezo.szamrendszer:=b.szamrendszer;
        Nevezo.elojel:=Poz;
        kerekites:=True;
  end;

  Procedure Hosszuszoroz(Var a, b, c, d : EgeszSzam);
    Var
       Sz1,Sz2,N1,N2,S1,S2,S3 : EgeszSzam;
       K,I : Integer;
       levag : boolean;
  begin
        If (MaxPontossag mod 2)=0
        then
          if (a.hossz=MaxPontossag) or (b.hossz=MaxPontossag)
          then
            tulcsordult:=True
          else
            begin
            levag:=True;
            Pontossag:=MaxPontossag-1;
            end
        else
        begin
          pontossag:=maxpontossag;
          levag:=false;
        end;
        if not tulcsordult
        Then
          begin
          k:=trunc((Pontossag-1)/2);
          sz1:=Nulla;
          sz2:=Nulla;
          n1:=Nulla;
          n2:=Nulla;
          For i:=0 to k do
          begin
            sz1.jegy[i]:=a.jegy[i];
            sz2.jegy[i]:=a.jegy[i+k+1];
            n1.jegy[i]:=b.jegy[i];
            n2.jegy[i]:=b.jegy[i+k+1];
          end;
          sz1.szamrendszer:=a.szamrendszer;
          sz2.szamrendszer:=a.szamrendszer;
          n1.szamrendszer:=b.szamrendszer;
          n2.szamrendszer:=b.szamrendszer;
          sz1.elojel:=a.elojel;
          sz2.elojel:=a.elojel;
          n1.elojel:=b.elojel;
          n2.elojel:=b.elojel;
          if a.hossz<=k then
            begin
            sz1.hossz:=a.hossz;
            sz2.hossz:=0;
            end
          else
            begin
            sz1.hossz:=k;
            sz2.hossz:=a.hossz-k-1;
            end;
          if b.hossz<=k then
            begin
            n1.hossz:=b.hossz;
            n2.hossz:=0;
            end
          else
            begin
            n1.hossz:=k;
            n2.hossz:=b.hossz-k-1;
            end;
          Szoroz(sz1,n1,s1);
          Szoroz(sz2,n2,s2);
          Osszead(sz1,sz2,s3);
          Osszead(n1,n2,sz2);
          Szoroz(s3,sz2,sz1);
          Kivon(sz1,s1,sz2);
          Kivon(sz2,s2,s3);
          n1:=Nulla;
          n2:=Nulla;
          For i:=0 to k do
            begin
            n1.jegy[k+i+1]:=s3.jegy[i];
            n2.jegy[i]:=s3.jegy[k+i+1];
            end;
          n1.szamrendszer:=s3.szamrendszer;
          n2.szamrendszer:=s3.szamrendszer;
          n1.elojel:=s3.elojel;
          n2.elojel:=s3.elojel;
          if s3.hossz<=k then
          begin
            n1.hossz:=s3.hossz+k+1;
            n2.hossz:=0
          end
          else
          begin
            n1.hossz:=2*k+1;
            n2.hossz:=s3.hossz-k-1;
          end;
          Osszead(s1,n1,c);
          if tulcsordult
          then
            begin
            Tulcsordult:=False;
            Osszead(s2,n2,s3);
            Osszead(s3,Egy,d);
            end
          else
            Osszead(s2,n2,d);
          if nagyobb(d,nulla) then c.hossz:=Pontossag;
          end;
          if levag
          then
            begin
            Pontossag:=MaxPontossag;
            if nagyobb(d,nulla)
            then
              begin
              c.jegy[Pontossag]:=d.jegy[0];
              c.hossz:=Pontossag;
              for i:=1 to d.hossz do
                d.jegy[i-1]:=d.jegy[i];
              d.jegy[d.hossz]:=0;
              if d.hossz>0 then d.hossz:=d.hossz-1;
              end;
            end;
  end;

  Procedure Tortosszead (Var a, b, osszeg : Tort);
    var
       c,d,e,f,
       g,h,kozos    : EgeszSzam;
       tul          : Boolean;
       szamrendszer : Integer;

    Procedure TSZ (Var a, b, c, d : EgeszSzam);
    begin
      If (a.hossz+b.hossz>=MaxPontossag)
      then
        begin
        Hosszuszoroz(a,b,c,d);
        if nagyobb(d,Nulla) then tul:=true;
        end
      else
        begin
        Szoroz(a,b,c);
        if tulcsordult
        then
          d:=nulla;
        d:=nulla;
        d.szamrendszer:=c.szamrendszer;
        end;
      d.elojel:=c.elojel;
    end;

    Procedure TK (Var a, b, c, d, e, f : PozSzam; hossz : integer);
      Var
         i,x,atvitel : Integer;
    begin
      atvitel:=0;
      for i:=0 to MaxPontossag do
        begin
        x:=b[i]-d[i]-atvitel;
        if x<0 then begin f[i]:=x+szamrendszer; atvitel:=1; end
               else begin f[i]:=x; atvitel:=0; end;
        end;
      for i:=0 to hossz do
        begin
        x:=a[i]-c[i]-atvitel;
        if x<0 then begin e[i]:=x+szamrendszer; atvitel:=1; end
               else begin e[i]:=x; atvitel:=0; end;
        end;
    end;

    Procedure TH(Var a, b : EgeszSzam; h : integer);
      Var i :integer;
    begin
      i:=h;
      while (i>0) and (a.jegy[i]=0) do
        i:=i-1;
      a.hossz:=i;
      if a.jegy[i]=0
      then
        begin
        i:=MaxPontossag;
        while (i>0) and (b.jegy[i]=0) do
          i:=i-1;
        b.hossz:=i;
        tul:=false;
        end;
    end;

  begin
    tul:=false;
    Lnko(a.nevezo,b.nevezo,kozos,c,d);
    TSZ(a.szamlalo,d,e,f);
    TSZ(b.szamlalo,c,kozos,g);

    if e.elojel=kozos.elojel
    then
      begin
      Osszead(e,kozos,c);
      if tulcsordult
      then                     
        begin
        Tulcsordult:=False;
        tul:=true;
        if e.elojel=Poz
        then
          osszead(f,egy,e)
        else
          kivon(f,egy,e);
        f:=e;
        end;
      if tul then
        osszead(f,g,e)
      else
        begin
        e:=Nulla;
        e.szamrendszer:=c.szamrendszer;
        end;
      end
    else
      begin
      if tul
      then
        begin
        szamrendszer:=e.szamrendszer;
        h:=Nulla;
        if nagyobb(f,g) or (egyenlo(f,g) and nagyobb(e,kozos))
        then
          begin
          TK(f.jegy,e.jegy,g.jegy,kozos.jegy,h.jegy,c.jegy,f.hossz);
          h.elojel:=f.elojel;
          c.elojel:=f.elojel;
          end
        else
          begin
          TK(g.jegy,kozos.jegy,f.jegy,e.jegy,h.jegy,c.jegy,g.hossz);
          h.elojel:=g.elojel;
          c.elojel:=g.elojel;
          end;
        e:=h;
        TH(e,c,g.hossz);
        end
      else
        begin
        osszead(e,kozos,c);
        e:=nulla;
        e.szamrendszer:=c.szamrendszer;
        end
      end;
    TSZ(a.nevezo,d,f,kozos);
    if tul then
      egyszerusit(c,e,f,kozos,osszeg.szamlalo,osszeg.nevezo)
    else
      begin
      osszeg.szamlalo:=c;
      osszeg.nevezo:=f;
      end;
  end;

  Procedure Tortkivon ( Var a, b, kulonbseg : Tort);
  begin
    if b.szamlalo.elojel=Neg then b.szamlalo.elojel:=Poz
                             else b.szamlalo.elojel:=Neg;
    Tortosszead(a,b,kulonbseg);
    if b.szamlalo.elojel=Neg then b.szamlalo.elojel:=Poz
                             else b.szamlalo.elojel:=Neg;
  end;

  Procedure Tortszoroz ( Var a, b, Szorzat : Tort);
    Var
       kozos1, kozos2, c1, c2, d1, d2 : EgeszSzam;
       Elojel1, Elojel2 : ElojelTipus;
       Tul : Boolean;
  begin
    Tul:=False;
    Elojel1:=a.szamlalo.elojel;
    a.szamlalo.elojel:=Poz;
    Lnko(a.szamlalo,b.nevezo,kozos1,c1,d1);
    Elojel2:=b.szamlalo.elojel;
    b.szamlalo.elojel:=Poz;
    Lnko(a.nevezo,b.szamlalo,kozos2,c2,d2);

    If (c1.hossz+d2.hossz>=MaxPontossag) or
    ((c1.hossz+d2.hossz+1=MaxPontossag) and
    (c1.jegy[c1.hossz]*d2.jegy[d2.hossz]>=c1.szamrendszer))
    then
      begin
      Hosszuszoroz(c1,d2,kozos2,kozos1);
      if not egyenlo(kozos1,nulla) then Tul:=True;
      end
    else
      begin
      Szoroz(c1,d2,kozos2);
      kozos1:=Nulla;
      kozos1.szamrendszer:=kozos2.szamrendszer;
      end;
    If (c2.hossz+d1.hossz+1>MaxPontossag) or
    ((c2.hossz+d1.hossz+1=MaxPontossag) and
    (c2.jegy[c2.hossz]*d1.jegy[d1.hossz]>=c2.szamrendszer))
    then
      begin
      Hosszuszoroz(c2,d1,c1,d2);
      if not egyenlo(d2,nulla) then Tul:=True;
      end
    else
      begin
      Szoroz(c2,d1,c1);
      d2:=Nulla;
      d2.szamrendszer:=c1.szamrendszer;
      end;
    if tul then
      Egyszerusit(kozos2,kozos1,c1,d2,Szorzat.szamlalo,szorzat.nevezo)
      { Tulcsordulas eseten az eredmenyt racionalis szammal kozeliti.
        Ha ez is tulcsordul, az eredmeny szamlalojanak, vagy nevezojenek
        hossza negativ lesz !!! }
    else
    begin
      Szorzat.szamlalo:=kozos2;
      Szorzat.nevezo:=c1;
    end;
    a.szamlalo.elojel:=elojel1;
    b.szamlalo.elojel:=elojel2;
    if elojel1=elojel2
    then
      Szorzat.szamlalo.elojel:=Poz
    else
      Szorzat.szamlalo.elojel:=Neg;
  end;

  Procedure Tortoszt (Var a, b, Hanyados : Tort);
    var
       c : Tort;
  begin
    c.szamlalo:=b.nevezo; c.nevezo:=b.szamlalo;
    If c.nevezo.elojel=Neg then
    begin
      c.nevezo.elojel:=Poz;
      if c.szamlalo.elojel=Neg then c.szamlalo.elojel:=Poz
                               else c.szamlalo.elojel:=Neg;
    end;
    Tortszoroz(a,c,hanyados);
  end;

  Procedure Konv_RacVal(Var valos: ValosSzam; {Var} racionalis: Tort);
    Var
       eg,mar : EgeszSzam;
       i      : Integer;
       szj    : Szamjegy;

    Procedure Normalas(Var a,b: EgeszSzam);
      Var
         jegy   : Szamjegy;
         i,d1,d2,
         norm   : Integer;
    Begin
      norm:=a.szamrendszer div (b.jegy[b.hossz]+1);
      if norm>1 then
      begin
        d1:=0;
        for i:=0 to a.hossz do
        begin
          d2:=a.jegy[i]*norm+d1;
          a.jegy[i]:=d2 mod a.szamrendszer;
          d1:=d2 div a.szamrendszer;
        end;
        if d1>0 then begin a.hossz:=a.hossz+1; a.jegy[a.hossz]:=d1; end;
                                               Szor:=Szor+3*(a.hossz+1);
        d2:=0;
        for i:=0 to b.hossz do
        begin
          d1:=b.jegy[i]*norm+d2;
          b.jegy[i]:=d1 mod b.szamrendszer;
          d2:=d1 div b.szamrendszer;
        end;
                                               Szor:=Szor+3*(b.hossz+1);
      end;
    End; { Norm l s }

    Procedure EgyJegyOsztas(Var osztando,oszto: EgeszSzam; Var h: Szamjegy);
      Var
         n,m,szr,
         i,d,x: Integer;
         q    : Szamjegy;
         seged: PozSzam;
         nagy : Boolean;
    Begin
       n:=osztando.hossz; m:=oszto.hossz; szr:=osztando.szamrendszer;
       {
                  a hanyados becslese
       }
       if osztando.jegy[n]=oszto.jegy[m] then q:=szr-1
          else begin
               q:=(szr*osztando.jegy[n]+osztando.jegy[n-1])
                         div oszto.jegy[m];
                                             Szor:=Szor+2; Plusz:=Plusz+1;
               end;
       {
                  a becsles gyors javitasa
       }
       if m>0 then while oszto.jegy[m-1]*q>(Szr*osztando.jegy[n]
                         +osztando.jegy[n-1]-q*oszto.jegy[m])*Szr
                         +osztando.jegy[n-2] do begin
                                                 q:=q-1;
                                                 Szor:=Szor+4; Plusz:=Plusz+3;
                                                end;
       {
                  a becsles ellenorzese es javitasa
       }
       repeat
         d:=0;
         for i:=0 to m do
         begin
           seged[i]:=(oszto.jegy[i]*q+d) mod Szr;
           d:=(oszto.jegy[i]*q+d) div Szr
         end;
                                    Szor:=Szor+3*(m+1); Plusz:=Plusz+2*(m+1);
         seged[m+1]:=d;
         nagy:=(d=0);
         if d<>0 then
         begin
           i:=m+1;
           while (i>0) and (osztando.jegy[n-m-1+i]=seged[i]) do i:=i-1;
           nagy:=(osztando.jegy[n-m-1+i]>=seged[i]);
         end;
         if not nagy then q:=q-1;
       until nagy;
       h:=q;
       d:=0;
       for i:=0 to m do
       begin
         x:=osztando.jegy[n-m-1+i]-seged[i]-d;
         if x<0 then begin x:=x+Szr; d:=1 end else d:=0;
         seged[i]:=x;
       end;
       for i:=0 to m do osztando.jegy[n-m+i]:=seged[i];
       osztando.jegy[0]:=0;
                                               Plusz:=Plusz+m+2;
    End; { EgyJegyOszt s }

  Begin { Konv_RacVal }
    Tulcsordult:=False;
    Oszt(racionalis.szamlalo,racionalis.nevezo,eg,mar);
    valos.egesz:=eg;
       { el“k‚szˇt‚s: }
    Alapszoroz(mar,1,mar);
    Normalas(mar,racionalis.nevezo);
    if mar.hossz<=racionalis.nevezo.hossz then
    begin
       for i:=mar.hossz+1 to racionalis.nevezo.hossz+1 do mar.jegy[i]:=0;
       mar.hossz:=racionalis.nevezo.hossz+1;
    end;
       { t”rtr‚sz-sz mol s }
    valos.tort.hossz:=0; i:=0;
    While (Not Nulla_e(mar)) and (valos.tort.hossz<Pontossag-1) do
            {a legmagasabb tort kitev“ a legnagyobb sorsz mu!!!}
    Begin
      EgyJegyOsztas(mar,racionalis.nevezo,szj);
      valos.tort.jegy[i]:=szj;
      valos.tort.hossz:=i; Inc(i);
    End;
  End; { Konv_RacVal }

  Procedure ValosKiir(valos: ValosSzam);
    Var
       k : Integer;
  Begin
    write(valos.egesz.jegy[0]:1,'.');
    for k:=0 to valos.tort.hossz do write(valos.tort.jegy[k]:1);
    writeln;
  End; { Kiir }



Begin
  Kerekites:=False;
  Egeszbol_Tort(Nulla,Egy,NullaTort);
  Egeszbol_Tort(Egy,Ketto,Fel);
  Egeszbol_Tort(Egy,Egy,EgyTort);
  Egeszbol_Tort(Ketto,Egy,KettoTort);
End.