Cod sursa(job #77159)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 13 august 2007 15:05:09
Problema Numere 2 Scor 75
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.85 kb
program p2;
var f:text;
    q,s1,s:string;
    er:integer;
    a,b,i,p1,e,p,d,g,k,u,j,t:longint;
    c:array[1..300]of integer;
begin
assign(f,'numere2.in');reset(f);
read(f,q);
close(f);
if length(q)<10 then begin
val(q,p,er);
if p=1 then begin
            a:=1;
            b:=1;
            end
       else begin
            i:=1;
            repeat
            i:=i+1;
            e:=0;
            p1:=1;
            repeat
            p1:=p1*i;
            e:=e+1;
            until p1>=p;
            if p1=p then d:=1;
            until d=1;
            a:=i;
            b:=e;
            end;
                       end
            else begin
                 d:=0;
                 i:=1;
                 repeat
                 i:=i+1;
                 e:=0;
                 k:=1;
                 c[1]:=1;
                 repeat
                 u:=0;
                 for j:=1 to k do
                     begin
                     t:=(c[j]*i+u)div 10;
                     c[j]:=(c[j]*i+u)mod 10;
                     u:=t;
                     end;
                 e:=e+1;
                 if t<>0 then repeat
                              k:=k+1;
                              c[k]:=t mod 10;
                              t:=t div 10;
                              until t=0;
                 if k=length(q) then begin
                 s1:='';
                 for j:=k downto 1 do
                     begin
                     str(c[j],s);
                     s1:=s1+s;
                     end;
                                       end;
                 until(k>length(q))or(s1=q);
                 if s1=q then d:=1;
                 until d=1;
                 b:=e;
                 a:=i;
                 end;
assign(f,'numere2.out');rewrite(f);
writeln(f,a);
writeln(f,b);
close(f);
end.