Cod sursa(job #285451)

Utilizator cristinabCristina Brinza cristinab Data 22 martie 2009 16:45:55
Problema Factorial Scor 65
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var n,p:longint;
    f,g:text;
    ok:boolean;

procedure citire;
begin
assign(f,'fact.in'); reset(f);
readln(f,p);
close(f);
end;

function numar_cifre(n:longint):longint;
var m,suma,q:longint;
begin
m:=n;
q:=5;
suma:=0;

while trunc(m/q)>0 do
      begin
      suma:=suma+trunc(m/q);
      q:=q*5;
      end;

numar_cifre:=suma;
end;

procedure caut_binar(st,dr:longint);
var stanga,dreapta,mijloc:longint;
begin
stanga:=1;
dreapta:=n;

while (stanga<=dreapta) and not ok do
      begin
      mijloc:=(stanga+dreapta) div 2;
      if numar_cifre(mijloc)<p then
         begin
         stanga:=mijloc+1;
         n:=mijloc;
         end
      else if numar_cifre(mijloc)>p then
              begin
              dreapta:=mijloc-1;
              n:=mijloc;
              end
           else begin
                ok:=true;
                if (mijloc mod 10<>0) or (mijloc mod 10<>5) then
                   begin
                   if mijloc-mijloc mod 10+5-mijloc<mijloc-mijloc mod 10 then n:=mijloc-mijloc mod 10+5
                                                                         else n:=mijloc-mijloc mod 10;
                   end
                else n:=mijloc;
                end;
      end;

end;

procedure rezolvare;
begin
assign(g,'fact.out'); rewrite(g);
if p=0 then writeln(g,0)
else begin
     n:=429496729;
     ok:=false;
     if numar_cifre(n)=p then writeln(g,n)
     else begin
          caut_binar(1,n);
          if not ok then writeln(g,-1)
                    else writeln(g,n);
          end;
     end;

close(g);
end;

begin
citire;
rezolvare;
end.