Cod sursa(job #85711)

Utilizator nodsoftwarenume complet nodsoftware Data 22 septembrie 2007 13:08:56
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.58 kb
program factorial;

{$APPTYPE CONSOLE}

uses
  SysUtils;
    Label IESIRE;
var fin,fout:text;
    min,div2,div5,i,j,p,n:integer;
    ok:boolean;
{*----------MAIN--------*}
begin
        assign(fin,'fact.in');
        assign(fout,'fact.out');
        reset(fin);
        rewrite(fout);
        readln(fin,p);
        if p = 0 then begin writeln(fout,1); goto IESIRE end;
        ok:=false;
        n:=p-1;
        while (not ok) and (n div p <=5) do
        begin
                inc(n);
                div2:=0;
                div5:=0;
                i:=0;
                while i <= n do
                begin
                        inc(i);
                        j:=i;
                        while j mod 2 = 0 do begin j:=j div 2; inc(div2) end;
                        while j mod 5 = 0 do begin j:=j div 5; inc(div5) end;
                end;
                min:=div2;
                if min > div5 then min:=div5;
                if min = p then ok:=true;
//                if (div2=p) and (div5=p) then ok:=true;
{                rez:=rez*j;
                inc(j);
                cifra:=0;
                i:=0;
                aux:=rez;
                while (rez <> 0) and (cifra = 0) do
                begin
                        cifra:=rez mod 10;
                        rez:=rez div 10;
                        if cifra = 0 then inc(i);
                end;
                rez:=aux;
                if i = p then ok:=true;}
        end;
        if ok then writeln(fout,n+1) else writeln(fout,-1);
        IESIRE:
        close(fout);
end.