Cod sursa(job #285471)

Utilizator cristinabCristina Brinza cristinab Data 22 martie 2009 17:01:18
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.4 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;
         end
      else if numar_cifre(mijloc)>p then
              begin
              dreapta:=mijloc-1;
              end
           else begin
                ok:=true;
                while numar_cifre(mijloc)=p do dec(mijloc);
                n:=mijloc+1;
                end;
      end;

end;

procedure rezolvare;
begin
assign(g,'fact.out'); rewrite(g);
if p=0 then writeln(g,1)
else begin
     n:=429496729;
     ok:=false;
     if numar_cifre(n)=p then
        begin
        while numar_cifre(n)=p do dec(n);
        writeln(g,n+1)
        end
     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.