Cod sursa(job #601371)

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

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

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