Cod sursa(job #27744)

Utilizator AymdTrimbitas Viorel Stefan Aymd Data 7 martie 2007 08:13:29
Problema Factorial Scor 10
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>2441405 then begin
                     pp:=pp+2441406;
                     n:=n+9765625;
                     end;

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

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

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

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

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

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

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

if p-pp>5 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.