Cod sursa(job #26295)

Utilizator hitmannCiocas Radu hitmann Data 5 martie 2007 14:00:41
Problema Kperm Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.5 kb
program kperm;
var n,k,p:integer;
    j,s,i:longint;
    as,ev:boolean;
    st:array[1..100]of integer;
    ap:array[1..5000]of integer;
procedure citire;
var f:text;
begin
assign(f,'kperm.in'); reset(f); read(f,n,p); close(f);
end;
procedure succesor;
begin
ev:=true;
if st[k]<n then begin
                if st[k]<>0 then dec(ap[st[k]]);
                as:=true;
                inc(st[k]);
                inc(ap[st[k]]);
                if ap[st[k]]>1 then ev:=false;
                end
                else as:=false;
end;
procedure valid;
begin
ev:=true;
s:=0;
if k>=p then
   begin
   for i:=k-p+1 to k do s:=s+st[i];
   if s mod p<>0 then ev:=false;
   end;
end;
function rez(x:longint):longint;
var s:int64;
begin
s:=1;
for i:=1 to n do begin s:=s*i;
                 if p>=666013 then repeat s:=s-666013; until s<666013;
                 end;
rez:=s;
end;
begin {pp}
citire;assign(output,'kperm.out');rewrite(output);
if not odd(p) then write(0)
 else if odd(n) and(p=k) then write(rez(k))
   else
    begin
j:=0;

k:=1;
st[k]:=0;
while k>0 do
 begin
 repeat
 succesor;
 if as and  ev then valid;
 until not as or (as and ev);
 if as then if k=n then  begin
                         inc(j);
                         if j>=666013 then j:=j-666013;
                         end
                   else begin inc(k); st[k]:=0; end
       else begin
            dec(ap[st[k]]);
            dec(k);
            end;
 end;
write(j);
 end;
close(output);
end.