Cod sursa(job #601378)

Utilizator ion824Ion Ureche ion824 Data 6 iulie 2011 10:35:15
Problema Factorial Scor 75
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.32 kb
Program factorial;
   var a,b:array[1..13]of longint;
       zerouri,i,cinciuri,m:longint;
       k:int64;
       f:text;

Begin
   assign(f,'fact.in'); reset(f); readln(f,zerouri); close(f);
   assign(f,'fact.out'); rewrite(f);
   if zerouri=0 then writeln(f,'1')
     else
       begin
         a[1]:=5; k:=5; m:=1; b[m]:=1;
         while k*5<100000000 do
           begin
             k:=k*5;
             inc(m);
             a[m]:=k;
             b[m]:=a[m-1]+b[m-1];
           end;
           a[m+1]:=13;
         m:=1;
         while zerouri>b[m] do inc(m);
         k:=b[m-1];
         cinciuri:=a[m-1]div 5;
         while cinciuri mod 5 <>0 do begin dec(cinciuri); dec(k); end;
         while k<zerouri do
           begin
             if k+5<=zerouri then
               begin
                 k:=k+5;
                 cinciuri:=cinciuri+5;
                 i:=2;
                 while 5*cinciuri mod a[i]=0 do
                   begin
                     inc(k);
                     inc(i);
                   end;
                end
              else
                begin
                  inc(k);
                  inc(cinciuri);
                end;


           end;
     if k=zerouri then writeln(f,5*cinciuri)
         else writeln(f,-1);
       end;
    close(f);
end.