Cod sursa(job #27758)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 7 martie 2007 08:32:16
Problema Factorial Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 kb
var f,g:text;
    n,p,pp:longint;

begin
assign(f,'fact.in');
reset(f);
read(f,p);
assign(g,'fact.out');
rewrite(g);
while p-pp>12207020 do begin
                     pp:=pp+12207031;
                     n:=n+48828125;
                     end;
while p-pp>2441396 do begin
                     pp:=pp+2441406;
                     n:=n+9765625;
                     end;
while p-pp>488272 do begin
                     pp:=pp+488281;
                     n:=n+1953125;
                     end;
while p-pp>97648 do begin
                     pp:=pp+97656;
                     n:=n+390625;
                     end;
while p-pp>19524 do begin
                     pp:=pp+19531;
                     n:=n+78125;
                     end;
while p-pp>3900 do begin
                     pp:=pp+3906;
                     n:=n+15625;
                     end;
while p-pp>776 do begin
                     pp:=pp+781;
                     n:=n+3125;
                     end;
while p-pp>152 do begin
                     pp:=pp+156;
                     n:=n+625;
                     end;
while p-pp>28 do begin
                     pp:=pp+31;
                     n:=n+125;
                     end;
while p-pp>4 do begin
                     pp:=pp+6;
                     n:=n+25;
                     end;
while p-pp>0 do begin
                     pp:=pp+1;
                     n:=n+5;
                     end;
if p=0 then n:=1;
if p=pp then write(g,n)
        else write(g,'-1');
close(g);
end.