Cod sursa(job #6302)

Utilizator VmanDuta Vlad Vman Data 18 ianuarie 2007 18:58:32
Problema Numere 2 Scor 65
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.1 kb
program numere2;
const zero=ord('0');
      baza=100000000;
var p,st,dr,m,pow:array[1..60]of int64; {base 10^8}
    lp,lst,ldr,lm,lpow:byte;
    semn:shortint;
    i,j:integer;
    c:char;
    s,ss:string[100];
    f:text;

function diferenta:boolean;
var i:integer;
begin
if lst<ldr then begin
                diferenta:=true;
                exit;
                end
           else
                for i:=lst downto 2 do
                        if st[i]<dr[i] then begin
                                                diferenta:=true;
                                                exit;
                                            end;
if st[1]+1>=dr[1] then diferenta:=false
                       else diferenta:=true;
end;

procedure solutie;
var k:int64;
    j:integer;
begin
assign(f,'numere2.out');rewrite(f);
write(f,m[lm]);
for j:=lm-1 downto 1 do begin
    k:=baza;
    while k>m[j] do begin
          k:=k div 10;
          write(f,0);
    end;
    write(f,m[j]);
end;
writeln(f);
write(f,i);
close(f);
end;

function egal:shortint;
var i:integer;
begin
if lpow<lp then begin
                egal:=-1;
                exit;
                end
           else if lpow>lp then begin
                                egal:=1;
                                exit;
                                end
           else if lpow=lp then
                for i:=lp downto 1 do
                    if pow[i]<p[i] then begin
                                        egal:=-1;
                                        exit;
                                        end
                                   else if pow[i]>p[i] then begin
                                                            egal:=1;
                                                            exit;
                                                            end;
egal:=0;
end;

procedure putere(exp:integer);
var i,j,k,semn:integer;
    r,rr:int64;
    aux:array[1..60]of int64;
begin
rr:=0;
lpow:=lm;
aux:=m;
for i:=2 to exp do
    begin
    for j:=1 to 60 do pow[j]:=0;
    semn:=1;
    for j:=1 to lm do begin
        for k:=1 to lpow do
          begin
          r:=(m[j]*aux[k]+rr+pow[j+k-1])div baza;
          pow[j+k-1]:=(m[j]*aux[k]+rr+pow[j+k-1])-r*baza;
          rr:=r;
          end;
       if rr>0 then begin
                    pow[j+k]:=rr;
                    if j+k=lm+lpow then semn:=0;
                    rr:=0;
                    end;
    end;
    lpow:=lm+lpow-semn;
    if lpow>lp then exit;
   aux:=pow;
   end;
end;

procedure medie;
var r,rr:int64;
    i:byte;
begin
rr:=0;
lm:=ldr;
for i:=1 to ldr do begin
    r:=(st[i]+dr[i]+rr)div baza;
    m[i]:=(st[i]+dr[i]+rr)-rr*baza;
    r:=r;
end;
if rr>0 then begin inc(lm);m[lm]:=rr;end;
rr:=0;
for i:=lm downto 1 do begin
    r:=(baza*rr+m[i]) mod 2;
    m[i]:=(baza*rr+m[i])div 2;
    rr:=r;
end;
if m[lm]=0 then dec(lm);
end;

begin
assign(f,'numere2.in');reset(f);
lp:=0;
readln(f,s);
while s<>'' do begin
      inc(lp);
      if length(s)>8 then begin
                          ss:=copy(s,length(s)-7,8);
                          delete(s,length(s)-7,8);
                          val(ss,p[lp],i);
                          end
                          else begin val(s,p[lp],i);s:='';end;
end;
close(f);

for i:=350 downto 2 do begin
    {initialization}
    lst:=1;
    st[1]:=2;
    ldr:=(lp div i)+2;
    dr[ldr]:=1;
    {binary search}
    while diferenta do begin
          medie;
          putere(i);
          semn:=egal;
          case semn of
               -1:begin
                  lst:=lm;
                  for j:=1 to lm do
                      st[j]:=m[j];
                  end;
                1:begin
                  ldr:=lm;
                  for j:=1 to lm do
                      dr[j]:=m[j];
                  end;
                0:begin
                  solutie;
                  halt;
                  end;
           end;
   end;
m:=st;
putere(i);
if egal=0 then begin
        solutie;halt;end;
end;
lm:=lp;
m:=p;
i:=1;
solutie;
end.