Cod sursa(job #525590)

Utilizator elffikkVasile Ermicioi elffikk Data 25 ianuarie 2011 16:23:10
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.9 kb
var p,n:longint;

procedure init;
var f:text;
begin
  assign(f, 'fact.in');
  reset(f);
  readln(f, p);
  close(f);
end;

procedure rez;
var f:text;
begin
  assign(f, 'fact.out');
  rewrite(f);
  write(f,n);
  close(f);
end;

function nrc(k:longint):longint;
var s,p:longint;
begin
  p:=k;
  s:=0;
  while p> 0
  do begin
    p:=p div 5;
    s:=s+p;
  end;
  nrc:=s;
end;

function cauta(a,b:longint):longint;
var p1:longint;
begin
  if (a=b)
  then
  begin
    if nrc(a*5)=p
    then cauta:=a*5
    else cauta:=-1
  end
  else
  begin
    p1:= nrc((a+b)div 2*5);
    if p1=p then cauta:=(a+b)div 2*5
    else
    begin
    if p1>p
    then cauta:=cauta(a, (a+b)div 2)
    else cauta:=cauta((a+b)div 2+1, b);
    end
 end
end;

procedure calc;
begin
  if p=0
  then n:=1
  else
  begin
    n:=cauta(1, p);
  end;
end;

begin
  init;
  calc;
  rez;
end.