Cod sursa(job #601377)

Utilizator ion824Ion Ureche ion824 Data 6 iulie 2011 10:23:50
Problema Factorial Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.26 kb
Program factorial;
   var a,b: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);
   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; suma:=cinciuri*5;
         while k<zerouri do
           begin
             inc(k);
             inc(cinciuri);
             if cinciuri mod 5 =0 then
                                begin
                                  i:=2;
                                  while 5*cinciuri mod a[i]=0 do
                                    begin
                                      inc(k);
                                      inc(i);
                                    end;
                               end

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