Cod sursa(job #39734)

Utilizator fogabFodor Gabor fogab Data 26 martie 2007 22:24:54
Problema Next Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.59 kb
const base=1000000000;
      max=100000;
      c:array[1..9] of int64=
      (1,10,100,1000,10000,100000,1000000,10000000,100000000);
type nr=array[0..max] of int64;
var f:text;
    j,i:integer;
    a,b,d,n,d2,n2:nr;
    h,this:int64;
    ok:boolean;

function minusz(a,b:nr):nr;
var i:integer;
begin
for i:=1 to a[0] do
 if a[i]>=b[i] then a[i]:=a[i]-b[i]
    else begin
         a[i]:=a[i]+base-b[i];
         a[i+1]:=a[i+1]-1;
         end;
minusz:=a;
end;

procedure plusz(var a:nr;b:nr);
var i,j:integer;
begin
for i:=1 to b[0] do begin
    a[i]:=a[i]+b[i];
    if a[i]>=base then begin
                       a[i+1]:=a[i+1]+a[i] div base;
                       a[i]:=a[i] mod base;
                       end;
    end;
while a[i]<>0 do inc(i);
a[0]:=i-1;
end;

function szor(a,b:nr):nr;
var i,j,k:integer;
    c:nr;
begin
fillchar(c,sizeof(c),0);
for i:=1 to a[0] do
    for j:=1 to b[0] do begin
        c[i+j-1]:=c[i+j-1]+a[i]*b[j];
        if c[i+j-1]>=base then begin
                               c[i+j]:=c[i+j]+c[i+j-1] div base;
                               c[i+j-1]:=c[i+j-1] mod base;
                               end;
        end;
if c[a[0]+b[0]]=0 then i:=a[0]+b[0]-1
else begin
i:=a[0]+b[0];
while c[i]>=base do begin
                    c[i+1]:=c[i] div base;
                    c[i]:=c[i] mod base;
                    inc(i);
                    end;
end;
c[0]:=i;
szor:=c;
end;

function bigger(a,b:nr):boolean; {a>=b}
var i:integer;
begin
if a[0]<b[0] then bigger:=false
else begin
     i:=a[0];
     while i<>0 do begin
     if a[i]>b[i] then begin bigger:=true;exit;end;
     if a[i]<b[i] then begin bigger:=false;exit;end;
     if a[i]=b[i] then begin dec(i);end;
     end;
     bigger:=false;
     end;
end;

procedure go;
var t:char;
begin
if not(eoln(f)) then
  begin
  read(f,t);
  go;
  inc(j);
  if j=7 then begin j:=1;inc(i);end;
  b[i]:=b[i]+c[j]*(ord(t)-48);
  end
else begin j:=0;i:=1;end;
end;

begin
assign(f,'next.in');
reset(f);
go;
j:=0;
b[0]:=i;
n:=b;
fillchar(b,sizeof(b),0);
readln(f);
go;
b[0]:=i;
n2:=b;
close(f);
b:=n;
a[0]:=1;
ok:=true;
while ok do
  begin
    d:=a;
    plusz(d,b);
    fillchar(d2,sizeof(d2),0);
    h:=0;
    for i:=d[0] downto 1 do
       begin
         h:=h*base+d[i];
         d2[i]:=h div 2;
         h:=h mod 2;
       end;
    if d2[d[0]]=0 then d2[0]:=d[0]-1
       else d2[0]:=d[0];
    if bigger(n,szor(d2,n2)) then a:=d2
       else b:=d2;
    ok:=false;
    for i:=1 to b[0] do
      if a[i]<>b[i] then begin ok:=true;break;end;
    if ok=true then
    begin
    ok:=false;
    if b[0]=a[0]+1 then
       begin
       if b[b[0]]<>1 then ok:=true
       else for i:=1 to a[0] do if a[i]<>999999 then begin ok:=true;break;end;
       end
    else if a[0]<>b[0] then ok:=true else
    begin
    i:=b[0];
    while b[i]=a[i] do
      begin
      dec(i);
      if i=0 then break;
      end;
    if b[i]-a[i]<>1 then ok:=true else
       for j:=1 to i-1 do
         if (b[j]<>0) or (a[j]<>999999) then ok:=true;
    end;
    end;
  end;

b[0]:=1;
b[1]:=1;
plusz(a,b);
a:=szor(a,n2);

assign(f,'next.out');
rewrite(f);
this:=base div 10;

repeat
if (a[a[0]] div this)<>0 then begin
        write(f,(a[a[0]] div this) mod 10);
        end;
this:=this div 10;
until this=0;

for i:=a[0]-1 downto 1 do begin
    this:=base div 10;
    repeat
    if (a[i] div this)=0 then write(f,0)
       else begin
            write(f,(a[i] div this) mod 10);
            end;
    this:=this div 10;
    until this=0;
    end;
close(f);
end.