小胖邮递员.pas

本程序引入了连通性状态压缩动态规划方法

program post;
const
max=18;
num=10000;
type
     shu=array[0..8] of integer;
var
f:array[0..1,0..180000] of shu;
prev,next:array[0..11,0..180000] of longint;
e:array[0..20] of longint;
i,j,k,n,m,t:longint;

operator +(a,b:shu)c:shu;
var
i,k:longint;
begin
fillchar(c,sizeof(c),0);
if a[0]>b[0] then c[0]:=a[0] else c[0]:=b[0];
k:=0;
for i:=1 to c[0]+1 do
     begin
     if i<=a[0] then k:=k+a[i];
     if i<=b[0] then k:=k+b[i];
     c[i]:=k mod num;
     k:=k div num;
     end;
if c[c[0]+1]<>0 then inc(c[0]);
end;

function find(p,k,t:longint):longint;
var
h,x:longint;
begin
h:=0;
p:=p-t;
repeat
  p:=p+t;
  if p>max then exit(0);
  if p<=0 then exit(0);
  x:=k mod e[p] div e[p-1];
  if x=1 then inc(h);
  if x=2 then dec(h);
until h=0;
find:=p;
end;

procedure up(g:longint);
begin
f[(t+1) and 1,g]:=f[(t+1) and 1,g]+f[t,k];
end;

procedure done(i,j,k:longint);
var
p,l,r:longint;
begin
p:=k-k mod e[j+2]+k mod e[j];
l:=k mod e[j+1] div e[j];
r:=k mod e[j+2] div e[j+1];
if (l=0) and (r=0) then
     up(p+e[j]+2*e[j+1])
else if (l=0) or (r=0) then
     begin
     up(p+(l+r)*e[j]);
     up(p+(l+r)*e[j+1]);
     end
else if (l=2) and (r=1) then
     up(p)
else if (l=1) and (r=2) and (i=m) and (j=n-1) then
     up(p)
else if (l=1) and (r=1) then
     up(p-e[next[j+2,k]-1])
else if (l=2) and (r=2) then
     up(p+e[prev[j+1,k]-1]);
end;

procedure start;
begin
f[1,0,0]:=1; f[1,0,1]:=1;
e[0]:=1;
for i:=1 to max do
     e[i]:=e[i-1]*3;
for k:=0 to e[n+1]-1 do
     for j:=1 to n+1 do
          begin
          i:=k mod e[j] div e[j-1];
          if i=1 then next[j,k]:=find(j,k,1);
          if i=2 then prev[j,k]:=find(j,k,-1);
          end;
end;

procedure writeshu(x:shu);
var
i:longint;
begin
write(x[x[0]]);
for i:=x[0]-1 downto 1 do
     begin
     write(x[i] div 1000);
     x[i]:=x[i] mod 1000;
     write(x[i] div 100);
     x[i]:=x[i] mod 100;
     write(x[i] div 10);
     write(x[i] mod 10);
     end;
writeln
end;

begin
readln(n,m);
if (n=1) or (m=1) then
     begin
     writeln(1);
     halt;
     end;
start;
for i:=1 to m do
     begin
     for j:=0 to n-1 do
          begin
          fillchar(f[t],sizeof(f[t]),0);
          t:=(t+1) and 1;
          for k:=0 to e[n+1]-1 do
          if (f[t and 1,k,0]>1) or (f[t and 1,k,1]<>0) then
               done(i,j,k);
          end;
     if i<>m then
          begin
          fillchar(f[t],sizeof(f[t]),0);
          t:=(t+1) and 1;
          for k:=0 to e[n]-1 do
               f[(t+1)and 1,3*k]:=f[t,k];
          end;
     end;
t:=(t+1) and 1;
f[t,0]:=f[t,0]+f[t,0];
writeshu(f[t,0]);
end.