Cod sursa(job #27749)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 7 martie 2007 08:19:03
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.43 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 pp<p do begin
if p-pp>2441396 then begin
                     pp:=pp+2441406;
                     n:=n+9765625;
                     end;

if p-pp>488272 then begin
                     pp:=pp+488281;
                     n:=n+1953125;
                     end;

if p-pp>97648 then begin
                     pp:=pp+97656;
                     n:=n+390625;
                     end;

if p-pp>19524 then begin
                     pp:=pp+19531;
                     n:=n+78125;
                     end;

if p-pp>3900 then begin
                     pp:=pp+3906;
                     n:=n+15625;
                     end;

if p-pp>776 then begin
                     pp:=pp+781;
                     n:=n+3125;
                     end;

if p-pp>152 then begin
                     pp:=pp+156;
                     n:=n+625;
                     end;

if p-pp>28 then begin
                     pp:=pp+31;
                     n:=n+125;
                     end;

if p-pp>4 then begin
                     pp:=pp+6;
                     n:=n+25;
                     end;

if p-pp>0 then begin
                     pp:=pp+1;
                     n:=n+5;
                     end;


end;
if p=0 then n:=1;
if p=pp then write(g,n)
        else write(g,'-1');
close(g);
end.