Cod sursa(job #17939)

Utilizator ioraIoana Radu iora Data 17 februarie 2007 15:07:42
Problema Factorial Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.1 kb
var p5,nr0:array[1..300] of longint;
    n,i,r,p,n0,put,ok,rest:longint;
    f1,f2:text;
begin
     assign(f1,'fact.in');
     reset(f1);
     assign(f2,'fact.out');
     rewrite(f2);

     readln(f1,p);
     if p=0 then writeln(f2,-1)
     else
     begin

     n:=1;
     p5[n]:=1;
     nr0[n]:=0;
     repeat
       n:=n+1;
       nr0[n]:=p5[n-1]+nr0[n-1];
       p5[n]:=p5[n-1]*5;
     until nr0[n]>p;

     for i:=0 to n-1 do
       if nr0[i+1]>p+1 then begin rest:=(p+1) div nr0[i]*p5[i]; break end;

     r:=p div nr0[n-1]*p5[n-1];
     if rest=0 then ok:=1;

     p:=p mod nr0[n-1];
     while (p<>0)and(ok<>1) do
       begin
         n0:=0;
         put:=0;
         for i:=0 to n-1 do
           if nr0[i+1]>p then begin n0:=nr0[i];put:=p5[i];break  end;
         for i:=0 to n-1 do
           if nr0[i+1]>p+1 then begin rest:=(p+1) div nr0[i]*p5[i]; break end;
         if rest=0 then ok:=1;
         r:=r+ p div n0*put;
         p:=p mod n0;
       end;
     if ok=0 then writeln(f2,r)
             else writeln(f2,-1);

     end;
     close(f1);
     close(f2);
end.