Cod sursa(job #317838)

Utilizator nod_softwareBudisteanu Ionut Alexandru nod_software Data 25 mai 2009 13:24:43
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 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;


{  for j:=1 to 20000 do
  begin}
{     p:=j;}
     while p > 0 do
     begin
         i:=13;
         while p+i-1 < b[i] do
         begin
             dec(i);
         end;


{         for j:=1 to 13 do
         begin

           if (i = j) and (p=5) then
           begin
              writeln(fout,-1);
              close(fout);
              Halt;
           end;
         end;}

         p:=p-b[i];
         rez:=rez+a[i];
         {if p = 10 then
         begin
           writeln(fout,1);
         end;              }
     end;


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

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