Cod sursa(job #317839)

Utilizator nod_softwareBudisteanu Ionut Alexandru nod_software Data 25 mai 2009 13:26:34
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.84 kb
program Fact;
const a : array [1..13] of longint = (5,25,125,625,3125,15625,78125,390625,1953125,9765625,48828125,244140625,1220703125);
      b:array [1..13] of longint =  (1,6,31,156,781,3906,19531,97656,488281,2441406,12207031,61035156,305175781);
var fin,fout:text;
    i,j,aux,n,m,p,zero,nr,rez:longint;
begin
     assign(fin,'fact.in'); reset(fin); assign(fout,'fact.out'); rewrite(fout);


     readln(fin,p); zero:=0;

     if p = 0 then
     begin
         writeln(fout,1);
         Close(fout);
         Halt;
     end;

     while p > 0 do
     begin
         i:=13;
         while p+i-1 < b[i] do
         begin
             dec(i);
         end;

         p:=p-b[i];
         rez:=rez+a[i];

     end;


     if p <0 then writeln(fout,-1  )
     Else
     writeln(fout,rez);

     close(fin); Close(fout);
end.