block.pas

本光盘是《国际大学生程序设计竞赛例题解（一）》的配套光盘

program block;
uses crt;
var
 e,t:array[1..32] of integer;   {保留的中间解}
 biao:array[1..32,1..32] of integer;   {将解变为输出形式的数组}
 s:array[-1..32,-1..32,0..1] of longint;   {计算用数组}
 lmin,l,n,m:integer;
 fs:string;
 fp:text;
 ch:char;
 total:longint;

procedure out;      {输出}
var
 i,j:integer;
begin
fillchar(biao,sizeof(biao),0);
e:=t;
inc(total);
writeln(fp,total);
for i:=1 to l do            {解的转换}
 begin
  j:=1;
  while e[i]>0 do begin biao[j,i]:=1;inc(j);dec(e[i]);end;
 end;
 for i:=m downto 1 do       {打印}
  begin
  for j:=1 to n do
    write(fp,biao[i,j],' ');
  writeln(fp);
  end;

end;

procedure work(v,x,z:integer);   {搜索过程}
var
 i,j:integer;
begin
 if v=l-v+1 then                   {判断是否找到解}
  begin
   if x=0 then exit;
   if x<=m then begin t[v]:=x;out;end;
   exit;
  end;
 if v>l-v+1 then
  begin
   if x=0 then out;
   exit;
  end;
{分情况}
 if z=0 then                      {要保证左>右时}
   for i:=1 to m do
     for j:=i to m do
       if x-i-j>=0 then
        begin
         t[v]:=i;t[l-v+1]:=j;
         if i=j then work(v+1,x-i-j,0)
                else work(v+1,x-i-j,1);
        end;
 if z=1 then                      {不用保证左>右时}
    for i:=1 to m do
      for j:=1 to m do
       if x-i-j>=0 then
        begin
         t[v]:=i;t[l-v+1]:=j;
         work(v+1,x-i-j,1);
        end
end;

procedure suan;  {计算过程}
var
 x,y,i,j:integer;
 rr:longint;
begin
{数据初始化}
 fillchar(s,sizeof(s),0);
 s[0,-1,0]:=1;s[0,-1,1]:=1;
 s[0,0,0]:=1;s[0,0,1]:=1;
 for x:=1 to m do begin s[x,1,0]:=1;s[x,1,1]:=1;end;
{-------------}
 for x:=2 to n do
   for y:=2 to x do            {求s[x,y];}
     begin
       {-----两种情况-----}
       for i:=1 to m do
        for j:=i to m do
         if x-i-j>=0 then
          if i=j then
           s[x,y,0]:=s[x,y,0]+s[x-i-j,y-2,0]
          else
           s[x,y,0]:=s[x,y,0]+s[x-i-j,y-2,1];
       {-----------------}
       for i:=1 to m do
         for j:=1 to m do
          if x-i-j>=0 then
           s[x,y,1]:=s[x,y,1]+s[x-i-j,y-2,1];
     end;
 rr:=0;
 {求总数}
 for i:=1 to n do
  rr:=rr+s[n,i,0];
 writeln('Total=',rr);
end;

begin
 {数据初始化}
 total:=0;
 fillchar(t,sizeof(t),0);
 write('N=');readln(n);
 write('M=');readln(m);
 {选择输出方式}
 write('MODE(A OR B)');
 ch:=readkey;writeln(ch);
 if upcase(ch)='A' then
  begin
   write('Filename:');readln(fs);
   assign(fp,fs);rewrite(fp);
  end
  else
   begin suan;exit;end;
 lmin:=trunc(n/m+0.99);
writeln(fp,n,' ',m);
{搜索寻解}
for l:=lmin to n do
 work(1,n,0);
 close(fp);
writeln('Total=',total);
end.