Cod sursa(job #362708)

Utilizator LacitekBondici Laszlo Lacitek Data 10 noiembrie 2009 19:28:04
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
program nulla;
const
    v : array[1..12] of longint = (5,25,125,625,3125,15625,78125,390625,1953125,9765625,48828125,244140625);
var
    f : text;
    p : longint;
    n : longint;
    function otos(a:longint):longint;
        var i : byte;
            s : longint;
        begin
            i := 1;
            s := 0;
            while (i <= 12) and (a div v[i] > 0) do
                begin
                    s := s+ a div v[i];
                    inc(i);
                end;
            otos := s;
        end;
begin
    assign(f,'fact.in'); reset(f);
    read(f,p);
    close(f);
    assign(f,'fact.out'); rewrite(f);
    if p = 0 then
        write(f,1)
    else
        begin
            n := 4*p;
            while otos(n)<p do
                inc(n);
            if otos(n) = p then
                write(f,n)
            else
                write(f,-1);
        end;
    close(f);
end.