Cod sursa(job #354425)

Utilizator EstarDaian Dragos Estar Data 7 octombrie 2009 23:46:48
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.77 kb
var p,p1,nr,k,j:longint;
g,f:text;
 begin
   assign(f,'fact.in');reset(f);
   assign(g,'fact.out');rewrite(g);
   read(f,p);
   nr:=0;
   k:=0;
   j:=(p div 3906) -(p div 61035156 );
   p1:= k+ p - ((p div 3906) ) +j;
   if j<>0 then begin
   if k+ p - ((p div 3906) ) +j div 5 <= p then
   k:= k+ p - ((p div 3906) ) +j;
   end
   else begin
   if j<>0 then
   while k+ p - p div 3906+j > p do begin
   k:=k-3906;
   j:=j-1;
   end;
   end;
   nr:=15625 * j;
   if k<>p then
   while 1=1 do begin
         nr:=nr+5;
         k:=k+1;
          if (nr mod 25 = 0) and (nr div 25 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 125 = 0) and (nr div 125 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 625 = 0) and (nr div 625 >= 1) then begin
         k:=k + 1; end;
if (nr mod 3125 = 0) and (nr div 3125 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 15625 = 0) and (nr div 15625 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 78125 = 0) and (nr div 78125 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 390625 = 0) and (nr div 390625 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 1953125 = 0) and (nr div 1953125 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 9765625 = 0) and (nr div 9765625 >= 1) then begin
         k:=k + 1; end;
         if (nr mod 48828125 = 0) and ( nr div 48828125 >=1) then begin
         k:=k + 1; end;
         if (nr mod 244140625 = 0) and ( nr div 244140625 >=1) then begin
         k:=k + 1; end;
         if (nr mod 1220703125 = 0) and ( nr div 1220703125 >=1) then begin
         k:=k + 1; end;
         if p<=k then break;
   end;
   if k<>p then nr:=-1;
   if p=0 then nr:=1;
   write(g,nr);
   close(f);
   close(g);
end.