Cod sursa(job #162219)

Utilizator borsosborsos adrian borsos Data 19 martie 2008 18:37:43
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.35 kb
var f,g:text;
    nr5,i,j,p,mij,mij2,max,min,nrr0,k:longint;
    ok:boolean;
    function nr0(x:longint):longint;
var i:longint;
begin
i:=0;
while x mod 15625 = 0 do begin i:=i+6; x:=x div 15625; end;
while x mod 3125 = 0 do begin i:=i+5; x:=x div 3125; end;
while x mod 625 = 0 do begin i:=i+4; x:=x div 625; end;
while x mod 125 = 0 do begin i:=i+3; x:=x div 125; end;
while x mod 25 = 0 do begin i:=i+2; x:=x div 25; end;
while x mod 5 = 0 do begin i:=i+1; x:=x div 5; end;
nr0:=i;
end;

begin
assign(f,'fact.in'); reset(f);
assign(g,'fact.out'); rewrite(g);

readln(f,p);
if p = 0 then writeln(g,'1') else begin
max:=p*10;
min:=1;
ok:=true;
mij2:=0;
while ok do begin
      mij:=(max + min) div 2;
      mij:= mij - mij mod 5;

      if mij2=mij then begin writeln(g,'-1'); break; end;

      nrr0:=0;
      for k := 1 to mij do begin
          nrr0:=nrr0 + nr0(k);
          if nrr0 > p then break;
                           end;
      if nrr0 < p then begin
                min:=mij;
                       end else
      if nrr0 > p then begin
                max:=mij;
                       end else
                       begin
                       writeln(g,mij);
                       ok:=false;
                       end;
      mij2:=mij;
              end;
                   end;
close(f);
close(g);

end.