Cod sursa(job #25778)

Utilizator skydomePop Paul skydome Data 4 martie 2007 14:34:10
Problema Kperm Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
var
f:text;
k,st:array[1..5000] of integer;
l,s,x,i,n,m:integer;
kk:boolean;



procedure scrie(i:integer);
var j:integer;
begin
kk:=true;
for j:=m to i do
if kk then
begin
s:=0;
for l:=j-m+1 to j do s:=s+st[l];
if s mod m<>0 then kk:=false;
end;
if kk then inc(x);
end;

function valid(i:integer):boolean;
var ok:boolean; j:integer;
begin
ok:=true;
for j:=1 to i-1 do
if st[i]=st[j] then ok:=false;
valid:=ok;
end;

procedure back(i:integer);
var pval:integer;
begin
for pval:=1 to n do
begin
st[i]:=pval;
if valid(i) then
if i=n then scrie(i) else back(i+1);
end;
end;




begin
assign(f,'kperm.in');
reset(f);
readln(f,n,m);
close(f);
x:=0;
back(1);
assign(f,'kperm.out');
rewrite(f);
writeln(f,x);
close(f);
end.