Cod sursa(job #601374)

Utilizator ion824Ion Ureche ion824 Data 6 iulie 2011 08:24:53
Problema Factorial Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
Program factorial;
   var a:array[1..13]of longint;
       zerouri,i,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 then
                            begin
                              i:=2;
                              suma:=suma+5;
                              while (suma mod a[i]=0) do inc(i);
                              k:=k+(i-2)
                            end
                        else
                          suma:=suma+5;

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