# Cod sursa(job #6301)

Utilizator Data 18 ianuarie 2007 18:57:42 Numere 2 70 fpc done Arhiva de probleme 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;
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:=250 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.
``````