Cod sursa(job #191155)

Utilizator FllorynMitu Florin Danut Flloryn Data 25 mai 2008 15:09:38
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.66 kb
program psacal;
var f,g:text; p:int64;
    x,aux,nr,d,k:int64;
    u,v:array[1..10] of int64;
begin
 assign(f,'fact.in'); reset(f);
 assign(g,'fact.out'); rewrite(g);
 read(f,p);
u[1]:=2; v[1]:=10;
u[2]:=24; v[2]:=100;
u[3]:=249; v[3]:=1000;
u[4]:=2499; v[4]:=10000;
u[5]:=24999; v[5]:=100000;
u[6]:=249998; v[6]:=1000000;
u[7]:=2499999; v[7]:=10000000;
u[8]:=24999999; v[8]:=100000000;
u[9]:=249999998; v[9]:=1000000000;
u[10]:=2499999999; v[10]:=100000000;
if p=0 then write(g,1)
 else
    begin
         k:=p;
         d:=0;
        while p<>0 do
               begin
                 d:=d+1;
                 p:=p div 10;
               end;
        if p>10000 then
                 begin
                       p:=k;
                       k:=u[d];
                       x:=v[d];
                      repeat
                         x:=x+5;
                         aux:=x;
                         while (aux mod 5=0) and (aux<>0) do
                           begin
                             k:=k+1;
                            aux:=aux div 5;
                           end;
                     until (k=p) or (k>p);
                    end
                  else
        begin
         p:=k;
         k:=u[d+1];
         x:=v[d+1];
               repeat
                  aux:=x;
                 while (aux mod 5=0) and (aux<>0) do
                 begin
                    k:=k-1;
                    aux:=aux div 5;
                 end;
                 x:=x-5;
              until (k=p) or (k<p);

         end;
      if k=p then write(g,x)
          else write(g,-1);
      end;
 close(f);
 close(g);
end.