unit pbigint;
{operations usuelles sur des entiers  pouvant atteindre 300 chiffres:bigint
 Unit‚ developp‚e par KPIZINGUI DARRYL :nobi_8@hotmail.com
 24 novembre 2007}
interface

 const maxbig=200; {longueur max du nombre en nombre de chiffres}
       basemax=255;
 type bigint=record
               t:array[1..maxbig] of -1..9;
               s:shortint;  {signe du nombre}
               end;

      tbase=array[1..basemax] of bigint;

      tbasel=array[1..basemax] of integer;

{----------------------------------------------}
procedure init(var b:bigint); {initialise  … 0}
procedure breadln(var a:bigint);{lecture au clavier}
procedure bwriteln(a:bigint);{ecriture sur stdout}
function  comp(a,b:bigint):integer; {compare a et b:0 si a=b;1 si b<a;-1 sinon}
procedure plus(a,b:bigint;var c:bigint); {addition comme on le fait au primaire}
procedure moins(a,b:bigint;var c:bigint); {soustraction}
procedure div2(a:bigint;var q:bigint);{division par 2}
procedure mult2(a:bigint;var c:bigint); {multiplication par 2}
procedure conv(a:longint;var c:bigint); {convertit un longint en bigint}
procedure prod(x,y:bigint;var c:bigint);{multiplication comme on le fait au primaire}
procedure babs(a:bigint;var c:bigint); {valeur absolue}
procedure bdiv(a,b:bigint;var c:bigint);{division entiere}
procedure bmod(a,b:bigint;var c:bigint);{reste d' une division euclidienne}
procedure prodmod(x,y,t:bigint;var c:bigint);{multiplication modulo n}
procedure brandom(n:integer;var c:bigint);{rend un nombre au hazard de n chiffres}
procedure expo(x,n:bigint;var c:bigint);{elevation … la puissance n}
function  premier(a:bigint):boolean;{determine si un nombre est premier}
procedure euclide(a,b:bigint;var u1,v1,c:bigint);{algorithme d' euclide etendu; c est le reste}
procedure expomod(a,n,b:bigint;var c:bigint); {puissance modulo}
procedure bfwriteln(var f:text;a:bigint);{ecriture de a dans le fichier f}
procedure bfreadln(var f:text;var a:bigint);{lecture d' un bigint dans le fihier f}
procedure tobasex(a,b:bigint;var t:tbase);{conversion de a en base b}
procedure tobase10(t:tbasel;b:bigint;var c:bigint);{conversion en base b}
function  bigtolong(a:bigint):longint;{convertit un bigint en longint}

type str100=string[100];

{--------------------------------------------------------------}
implementation
procedure  init(var b:bigint);
  var i:integer;
  begin
  for i:=1 to maxbig do
   b.t[i]:=-1;
  b.s:=1;
  b.t[1]:=0;
  end;

  {--------------------------------------------------------------}

procedure bwriteln(a:bigint);
 var i:integer;
 begin
 i:=maxbig;
 if a.s=-1 then
   write('-');
 while(i<=maxbig) and (i>0) do
  begin
  if a.t[i]<>-1 then
  write(a.t[i]);
  i:=i-1;
  end;
 writeln;
end;

{--------------------------------------------------------------}

procedure breadln(var a:bigint);
 var i,j:integer;
     ch:string;
 begin
 init(a); i:=1;
 readln(ch);
 j:=length(ch);
 if (ch[1]='-') or (ch[1]='+') then
  begin
  if ch[1]='-' then
   a.s:=-1
   else
    a.s:=1;
  i:=2;
  j:=j-1;
 end;
 while (i<=length(ch)) and (ch[i] in ['0'..'9']) do
  begin
  a.t[j]:=ord(ch[i])-ord('0');
  j:=j-1;
  i:=i+1;
  end;
 end;

 {--------------------------------------------------------------}

 {compare deux nombres ecrits sous forme de chaine}
function compc(ch1,ch2:str100):integer;
 var i,l,l2:integer;
 begin
 l:=length(ch1);
 l2:=length(ch2);
 i:=1;
 while (i<l) and (ch1[i]='0') do
  begin
  ch1:=copy(ch1,i+1,l);
  i:=i+1;
  end;
  i:=1;
 while (i<l2) and (ch2[i]='0') do
  begin
  ch2:=copy(ch2,i+1,l2);
  i:=i+1;
  end;
  l:=length(ch1);
  l2:=length(ch2);
  if l>l2 then
   compc:=1
   else if l<l2 then
    compc:=-1
    else
     if ch1>ch2 then
     compc:=1
     else if ch1<ch2 then
      compc:=-1
      else
      compc:=0;
 end;

 {--------------------------------------------------------------}

function element(a:bigint):integer;
  var i,j:integer;
      trouve:boolean;
  begin
  trouve:=false;
  for i:=1 to maxbig do
   if not trouve then
    if a.t[i]<=-1 then
     begin
      j:=i-1;
      trouve:=true;
     end;
  element:=j;
end;

{--------------------------------------------------------------}

function comp(a,b:bigint):integer;
  var i,maxa,maxb,q:integer;
      ch,ch2:str100;
  begin
  if (a.s=1) and (b.s=-1) then
   comp:=1
   else if (a.s=-1) and (b.s=1) then
    comp:=-1
    else begin
   maxa:=element(a);
   maxb:=element(b);
   ch:=''; ch2:='';
   for i:=maxa downto 1 do
    ch:=ch+char(ord('0')+a.t[i]);
   for i:=maxb downto 1 do
    ch2:=ch2+char(ord('0')+b.t[i]);
    comp:=compc(ch,ch2);
    end;
end;

{--------------------------------------------------------------}

{addition de a+b entiers naturels}
procedure addition(a,b:bigint;var c:bigint);
  var i,k:integer;
  begin
  for i:=1 to maxbig do
   c.t[i]:=0;
  for i:=maxbig downto 1 do
   begin
   if a.t[i]=-1 then
    a.t[i]:=0;
   if b.t[i]=-1 then
    b.t[i]:=0;
   end;
  k:=0;
  for i:=1 to maxbig do
   begin
   k:=a.t[i]+b.t[i]+k;
   c.t[i]:=k mod 10;
   k:=k div 10;
   end;
   i:=maxbig;
   while (c.t[i]=0) and (i>1) do
    begin
    c.t[i]:=-1;
    i:=i-1;
    end;
   c.s:=a.s;
  end;

  {--------------------------------------------------------------}

  {soustraction a-b entiers naturels}
procedure soustraction(a,b:bigint;var c:bigint);
  var d:bigint;
      i,k:integer;
  begin
  for i:=1 to maxbig do
   c.t[i]:=0;
 for i:=maxbig downto 1 do
  begin
  if a.t[i]=-1 then
   a.t[i]:=0;
  if b.t[i]=-1 then
   b.t[i]:=0;
  end;
 k:=0;
 c.s:=1;
 if comp(a,b)=-1 then
  begin
  d:=a; a:=b; b:=d;
  c.s:=-1;
  end;
 for i:=1 to maxbig do
  begin
  k:=a.t[i]-(b.t[i]+k);
  if k<0 then
   k:=k+20;
   c.t[i]:= k mod 10;
   k:=k div 10;
   end;
  i:=maxbig;
  while (c.t[i]=0) and (i>1) do
   begin
   c.t[i]:=-1;
   i:=i-1;
   end;
  end;

{--------------------------------------------------------------}

  procedure plus(a,b:bigint;var c:bigint);
   var xx:bigint;
   begin
   if comp(b,a)=1 then
    begin
    xx:=a; a:=b; b:=xx;
    end;

   if(a.s*b.s)=1 then
    addition(a,b,c)
    else
     begin
     b.s:=b.s* -1;
     soustraction(a,b,c);
     end;
  end;

{--------------------------------------------------------------}

  procedure moins(a,b:bigint;var c:bigint);
  var s:integer;
      xx:bigint;
  begin
  if comp(b,a)=1 then
    begin
    xx:=a; a:=b; b:=xx;
    end;
  if (a.s*b.s)=1 then
   begin
   s:=a.s;
   a.s:=1; b.s:=1;
   Soustraction(a,b,c);
   c.s:=s*c.s;
   end
   else
    begin
    b.s:=b.s* -1;
    addition(a,b,c);
    end;
  s:=maxbig;
  while (c.t[s]=0) and (s>1) do
   begin
   c.t[s]:=-1;
   s:=s-1;
   end;
  end;

{--------------------------------------------------------------}

  procedure mult2(a:bigint;var c:bigint);
  var i,j,k:integer;
  begin
  k:=0;
  init(c);
  i:=1;
  while (i<=maxbig) and (a.t[i]<>-1) do
   begin
   k:=2*a.t[i]+k;
   j:=k div 10;
   if j<> 0 then
    c.t[i]:=k mod (j*10)
    else
     c.t[i]:=k;
   k:=j;
   i:=i+1;
   end;
  if (i<maxbig) and (k<>0) then
   c.t[i+1]:=k
   else if (i>=maxbig) and (k<>0) then
    begin
    writeln;
    writeln('depacement de capacite');
    readln;
    halt(0);
    end;
   i:=maxbig;
   while (c.t[i]=0) and (i>1) do
    c.t[i]:=-1;
  c.s:=a.s;
end;

{--------------------------------------------------------------}

{deplace les elements de a d' un rang}
procedure deplace(var a:bigint);
  var i,n:integer;
  begin
  n:=element(a);
  for i:=n downto 1 do
   a.t[i+1]:=a.t[i];
 end;


 {--------------------------------------------------------------}

 procedure div2(a:bigint;var q:bigint);
  var i,r,n:integer;
  begin
  r:=0;
  init(q);
  n:=element(a);
  q.t[1]:=-1;
  for i:=1 to maxbig do
   begin
   r:=r*10+a.t[n];
   deplace(q);
   q.t[1]:=r div 2;
   r:=r mod 2;
   n:=n-1;
   if n<=0 then
    break;
   end;
  q.s:=a.s;
   i:=maxbig;
  while ((q.t[i]=0) or (q.t[i]=-1)) and (i>1) do
   begin
   q.t[i]:=-1;
   i:=i-1;
   end;
 end;

 {--------------------------------------------------------------}

procedure conv(a:longint;var c:bigint);
 var k,i:integer;
 begin
 init(c);
 i:=1;
 if a<0 then
  c.s:=-1
  else
   c.s:=1;
 a:=abs(a);
 while a>0 do
  begin
  c.t[i]:=a mod 10;
  a:=a div 10;
  i:=i+1;
  end;
 end;

 {--------------------------------------------------------------}

procedure prod(x,y:bigint;var c:bigint);
var  i,j,r,d,k,maxa,maxb,l:integer;
     q:bigint;
begin
maxa:=element(x);  maxb:=element(y);
init(q);
l:=1;
for i:=1 to maxb do
 begin
 d:=l; r:=0;
 for j:=1 to maxa do
  begin
  r:=r+(x.t[j]*y.t[i]);
  k:=r div 10;
  if q.t[d]=-1 then
   q.t[d]:=0;
  if k=0 then   begin
   q.t[d]:=q.t[d]+r  ;
   end
   else begin
    q.t[d]:=q.t[d]+(r mod (10*k));
    end;
    if not(q.t[d]<=9) then
     begin
     q.t[d]:=q.t[d] mod 10;
     if q.t[d+1]=-1 then
       q.t[d+1]:=0;
     inc(q.t[d+1],1);
     end;
  r:=k;
  inc(d,1);
  end;
  if not(r=0) then
   begin
    if q.t[d]=-1 then
      q.t[d]:=0;
    inc(q.t[d],r);
    if not(q.t[d]<=9) then
     begin
     q.t[d]:=q.t[d] mod 10;
     if q.t[d+1]=-1 then
       q.t[d+1]:=0;
     inc(q.t[d+1],1);
     end;
  end;
  l:=l+1;
 end;
 q.s:=x.s*y.s;
 c:=q;
 end;

 {--------------------------------------------------------------}

procedure babs(a:bigint;var c:bigint);
  begin
  c:=a;
  c.s:=1;
end;

{--------------------------------------------------------------}

procedure bdiv(a,b:bigint;var c:bigint);
    var v,k,q,l,z:bigint;
        s,n,d,m,i,j:integer;
    begin
    conv(0,v);
    if comp(b,v)=0 then
     begin
     writeln;writeln('division par zero');
     readln;
     halt(0);
     end;
    if comp(a,v)=0 then
     c:=v
     else
      begin
      s:=a.s*b.s; a.s:=1; b.s:=1;
      n:=element(a);
      d:=1;
      init(k); init(q); init(l);
      k.t[1]:=-1; q.t[1]:=-1;
      for i:=n downto 1 do
       begin
       deplace(k);
       k.t[1]:=a.t[i];
       if comp(k,b)>=0 then
        for j:=1 to 9 do
         begin
         conv(j,z);
         prod(b,z,l);
         moins(k,l,l);
         if comp(l,b)<0 then
          begin
          deplace(q);
          q.t[1]:=j;
          k:=l;
          break;
          d:=d+1;
          end;
         end
         else
          begin
          deplace(q);
          q.t[1]:=0;
          d:=d+1;
          end;
         end;
        end;
         c:=q;
       i:=maxbig;
       while ((c.t[i]=-1) or (c.t[i]=0)) and (i>1) do
        begin
        c.t[i]:=-1;
        i:=i-1;
        end;
 end;

{--------------------------------------------------------------}

procedure bmod(a,b:bigint;var c:bigint);
    var v:bigint;
    begin
    conv(0,v);
    if comp(b,v)=0 then
     begin
     writeln('division par zero');
     readln;
     halt(0);
     end;
    if comp(a,v)=0 then
     conv(0,c)
     else
      begin
      bdiv(a,b,v);
      prod(b,v,v);
      moins(a,v,c);
      end;
    end;


{--------------------------------------------------------------}

procedure prodmod(x,y,t:bigint;var c:bigint);
var p:bigint;
    s:integer;
begin
x.s:=1; y.s:=1;
prod(x,y,p);
bmod(p,t,p);
c:=p;
end;

{--------------------------------------------------------------}

procedure brandom(n:integer;var c:bigint);
 var i:integer;
     b:bigint;
 begin
 if n>maxbig then
  n:=maxbig;
 randomize;
 init(b);
 if n>0 then
   begin
   for i:=1 to (n-1) do
     b.t[i]:=random(10);
     b.t[n]:=1+random(9);
     b.s:=1;
     c:=b;
     end
      else
       conv(0,c);
 end;

 {--------------------------------------------------------------}

procedure expo(x,n:bigint;var c:bigint);
   var b,v,p,k,r,q:bigint;
   begin
   conv(0,v);
   if (comp(n,v)<0) then
   begin
   writeln;writeln('exposant negatif: resultat non entier');
   readln;
   halt(0)
   end;
   k:=n; p:=x; conv(1,r);  conv(1,q);
   while comp(k,v)=1 do
     begin
     div2(k,b); mult2(b,b);
     if ( comp(k,b)<>0) then
      begin
      prod(p,r,r); moins(k,q,k); div2(k,k);
      end
      else
      div2(k,k);
      prod(p,p,p);
   end;
  c:=r;
end;

{--------------------------------------------------------------}

function premier(a:bigint):boolean;
  var test:boolean;
      i,q,r,v:bigint;
  begin
  test:=true;
  div2(a,q);
  conv(2,v);
  bmod(a,v,r);
  conv(0,v);
  if comp(r,v)=0 then
   test:=false
   else
    begin
    conv(3,i);
    bmod(a,i,r);
    conv(0,v);
    while (comp(i,q)<=0) and (comp(r,v)<>0) do
     begin
     conv(2,v);
     plus(i,v,i);
     bmod(a,i,r);
     conv(0,v);
     end;
    if comp(i,q)<=0 then
     test:=false;
    end;
  premier:=test;
 end;

{--------------------------------------------------------------}

procedure euclide(a,b:bigint;var u1,v1,c:bigint);
  var q,r,v,p:bigint;
      wp,wn,w :array[1..3] of bigint;
  begin
  wp[1]:=a; conv(1,wp[2]); conv(0,wp[3]);
  wn[1]:=b; conv(0,wn[2]); conv(1,wn[3]);
  bdiv(a,b,q);
  bmod(a,b,r);
  conv(0,v);
  while comp(r,v)<>0 do
   begin
   w[1]:=r;
   prod(q,wn[2],p);
   moins(wp[2],p,w[2]);
   prod(q,wn[3],p);
   moins(wp[3],p,w[3]);
   wp:=wn;
   wn:=w;
   bmod(wp[1],wn[1],r);
   bdiv(wp[1],wn[1],q);
   end;
  u1:=w[2];
  v1:=w[3];
  c:=w[1];
 end;

 {--------------------------------------------------------------}

procedure expomod(a,n,b:bigint;var c:bigint);
 var v:bigint;
  var j,k :integer;
      i:longint;
 begin
 i:=element(b);
 bwriteln(a);
 bwriteln(b);
 bwriteln(n);
 writeln('element :',i);

  conv(1,v);
 for j:=1 to i do
  begin
  writeln('compteur:', j);
   prodmod(v,a,n,v);
  end;
  c:=v;
  write('result');
  bwriteln(c);
 end;

{--------------------------------------------------------------}

procedure bfwriteln(var f:text;a:bigint);
 var i:integer;
 begin
 if a.s=-1 then
  write(f,'-')
  else write(f,'+');
 i:=1;
 while (i<=maxbig) do
  begin
  if a.t[i]<>-1 then
  write(f,a.t[i]);
  i:=i+1;
  end;
  writeln(f,'');
 end;

{--------------------------------------------------------------}

procedure bfreadln(var f:text;var a:bigint);
 var i:integer;
     ch:string;
 begin
 readln(f,ch);
 init(a);
 if ch[1]='-' then
  a.s:=-1
  else a.s:=1;
 for i:=2 to length(ch) do
  a.t[i-1]:=ord(ch[i])-ord('0');
 for i:=2 to length(ch) do
  if not (ch[i] in ['0'..'9']) then
   begin
   writeln;writeln('caractere non numerique');
   readln;
   halt(0);
   end;
  end;

{--------------------------------------------------------------}

 procedure tobasex(a,b:bigint;var t:tbase);
  var i:integer;
    v:bigint;
  begin
  for i:=1 to basemax do
   conv(-1,t[i]);
   if comp(a,b)=-1 then
    t[i]:=a
    else
     begin
     i:=1;
     conv(0,v);
     while comp(a,v)<>0 do
      begin
      bmod(a,b,t[i]);
      if i<>basemax then
       i:=i+1;
      bdiv(a,b,a);
      end;
     end;
   end;

{--------------------------------------------------------------}

  procedure tobase10(t:tbasel;b:bigint;var c:bigint);
   var i:integer;
       a,v,w,z:bigint;
   begin
   init(a); conv(-1,w);  init(v);
   for i:=1 to basemax do
    begin
    conv(t[i],z);
    if (comp(z,w)=0) then else
    begin
    conv(i-1,v);
    expo(b,v,v);
    conv(t[i],z);
    prod(z,v,v);
    plus(a,v,a);
    end;
    end;
  c:=a;
 end;

 {--------------------------------------------------------------}

 function bigtolong(a:bigint):longint;
  var l:longint;
      i,e,j,s:integer;
      v:bigint;
  begin
  conv(1000000,v);
  if comp(a,v)=1 then
   begin
   writeln;writeln('depacement de capacite');
   readln;
   halt(0);
   end;
  l:=0;
  e:=element(a);
  for i:=1 to e do
   begin
   s:=1;
   for j:=1 to (i-1) do
    s:=10*s;
   l:=l+a.t[i]*s;
   end;
   if a.s=-1 then
    l:=-l;
  bigtolong:=l;
 end;
{------------------c' est enfin termin‚--------------------}
begin
end.