Cod sursa(job #163543)

Utilizator vanila_CPPIonescu Victor Cristian vanila_CPP Data 22 martie 2008 14:46:06
Problema Sandokan Scor 25
Compilator fpc Status done
Runda preONI 2008, Runda Finala, Clasele 5-8 Marime 3.38 kb
program sandokan;
var f,g:text;
        fact:array[1..5001] of longint;
        n,k:longint;
        constanta:int64;
        prime:array[1..5001] of longint;
        nrprime:longint;
        howmany:array[1..5001] of longint;





procedure iofile;
begin
        assign(f,'sandokan.in');reset(f);
        assign(g,'sandokan.out');rewrite(g);
        readln(f,n,k);
        constanta:=2000003;
        close(f);
end;



function prim(x:longint):boolean;
var d:longint;
begin
        if (x=1) or (x=0) then prim:=false else
                begin
                        prim:=true;
                        for d:=2 to trunc(sqrt(x)) do
                                if x mod d=0 then
                                        begin
                                                prim:=false;
                                                exit;
                                        end;
                end;
end;


procedure det_prime;
var i:longint;
begin
        for i:=1 to n do
                if prim(i) then
                        begin
                                inc(nrprime);
                                prime[nrprime]:=i;
                        end;
end;


function logaritmic(a,b:int64):int64;
var i,pow,current,rez:int64;
begin
        rez:=1;
        pow:=0;
        current:=a;
        while (1 shl (pow))<=b do
                begin
                        if ((1 shl (pow)) and b)<>0 then
                                rez:=(rez*current) mod constanta;
                        inc(pow);
                        current:=(current*current) mod constanta;
                end;
        logaritmic:=rez;
end;
procedure prel;
var npart,countop,ind,exp,x,rest,rez:int64;
        i:longint;
begin
        countop:=0;
        npart:=n;
        while npart>=k do
                begin
                        inc(countop);
                        for i:=npart-k+1 to npart-1 do
                                inc(howmany[i]);
                        npart:=npart-k+1;
                end;
        fillchar(fact,sizeof(fact),0);
        for i:=2 to k-1 do
                howmany[i]:=howmany[i]-countop;
        for i:=2 to n-1 do
                if howmany[i]<>0 then
                begin
                        ind:=1;
                        x:=i;
                        while (ind<=nrprime)and(x<>1) do
                                begin
                                        exp:=0;
                                        while (x mod prime[ind])=0 do
                                                begin
                                                        x:=x div prime[ind];
                                                        inc(exp);
                                                end;
                                        fact[prime[ind]]:=fact[prime[ind]]+
                                        howmany[i]*exp;
                                        inc(ind);
                                end;
                end;
        rez:=1;
        for i:=1 to n do
                if fact[i]<>0 then
                        begin
                                rest:=logaritmic(i,fact[i]);
                                rez:=(rez*rest) mod constanta;
                        end;
        writeln(g,rez);
        close(g);
end;


begin
        iofile;
        det_prime;
        prel;
end.