BZOJ 1087-程序员宅基地

var
  f:array[0..10,0..90,0..600] of int64;
  a:Array[0..600] of longint;
  count:array[0..600] of longint;
  ans:int64;
  n,m:longint;
  
procedure init;
var
  t,i:longint;
begin
  readln(n,m);
  fillchar(count,sizeof(count),0);
  for i:=0 to (1 shl n)-1 do
    if (i and (i shl 1) =0) and (i and (i shr 1) = 0) then
       begin
         inc(a[0]);
         a[a[0]]:=i;
         t:=i;
         while t>0 do
           begin
             t:=t- (t and -t);
             inc(count[a[0]]);
           end;
       end;
end;

procedure main;
var
  i,j,k,l:longint;
begin
  fillchar(f,sizeof(f),0);
  for i:=1 to a[0] do
    f[1,count[i],a[i]]:=1;
  for i:=2 to n do
    for j:=0 to m do
      if i*n>=j then
         for k:=1 to a[0] do
           if count[k]<=j then
              for l:=1 to a[0] do

                if ( count[l]<=j) and
                   ( (a[k] shl 1) and a[l]=0 ) and
                   ( (a[k] shr 1) and a[l]=0 ) and
                   ( a[k] and a[l]=0) then 
                     f[i,j,a[k]]:=f[i-1,j-count[k],a[l]]+f[i,j,a[k]];                      

    
  for i:=1 to a[0] do
    ans:=ans+f[n,m,a[i]];
  writeln(ans);
end;

begin
      init;
      main;
end.