divide.pas

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

program Divide;
type tp=array [1..20,1..20] of byte;	{棋盘的数据类型}
     ts=array [1..2] of shortint;	{二维坐标数据类型}
     ta=array [1..100] of ts;	{坐标组数据类型，描述A或B部分的形状}
var source,extend,ss:tp;						
    a,b,c:ta;			{a描述A部分形状，b描述B部分的形状}
    e:array [1..100] of ts;	{相连方格链表}
    f:array [1..100] of ts;
    es,ep,m,n,i,j,en:integer;cc:char;	{ep链表可选方格的起始位置}
    fin,fout:text;
    p:tp;

const di:array [1..4] of shortint=(1,-1,0,0);	{方向的位移}
      dj:array [1..4] of shortint=(0,0,1,-1);

function individual(p,n:integer):integer;
{判断是否连通，采用广度搜索算法}
  var i,j,r,t,t1,t2:integer;
  begin
    ss:=source;
    for i:=1 to p-1 do if source[e[i,1],e[i,2]]=2 then
      begin
        f[1,1]:=e[i,1];f[1,2]:=e[i,2];
        t:=0;r:=1; ss[e[i,1],e[i,2]]:=0;
        repeat
          inc(t);
          for j:=1 to 4 do
            begin
              t1:=f[t,1]+di[j];
              t2:=f[t,2]+dj[j];
              if (t1<1) or (t1>m) or (t2<1) or (t2>m) then continue;
              if ss[t1,t2]<>2 then continue;
              inc(r);
              f[r,1]:=t1;f[r,2]:=t2;
              ss[t1,t2]:=0;
            end;
        until t=r;
        if  r=n then begin individual:=0;exit; end;
        for j:=i+1 to p-1 do if ss[e[j,1],e[j,2]]=2 then
          begin
            individual:=2;exit;
          end;
        individual:=1;exit;
      end;
    individual:=0;
  end;

function order(var a:ta;var la:integer):boolean;
{将a部分矢量化}
  var i,j:integer;
      temp:ts;
  begin
    {先排序，使左上角方格排在第一位}
    for i:=1 to la do for j:=i+1 to la do
    if (a[i,1]>a[j,1]) or ((a[i,1]=a[j,1]) and (a[i,2]>a[j,2])) then
      begin
        temp:=a[i];
        a[i]:=a[j];
        a[j]:=temp;
      end;
    order:=true;
    {求各方格与左上角方格的相对位移}
    for i:=la downto 1 do
    begin
      dec(a[i,1],a[1,1]);
      if a[i,1]>n-1 then order:=false;
      dec(a[i,2],a[1,2]);
      if (a[i,2]<0) or (a[i,2]>n-1) then order:=false;
    end;
  end;

procedure revote(var a:ta;la:integer);{将a部分旋转90度}
  var i,temp:integer;
  begin
    for i:=1 to la do
      begin
        temp:=a[i,1];
        a[i,1]:=a[i,2];
        a[i,2]:=-temp;
      end;
  end;

procedure recover(var a:ta;la:integer);{将a部分翻转}
  var i,temp:integer;
  begin
    for i:=1 to la do
      begin
        temp:=a[i,2];
        a[i,1]:=a[i,1];
        a[i,2]:=-temp;
      end;
  end;

function block(var a:ta;var la:integer;var b:ta;var lb:integer):boolean;
{判断a、b两部分是否可以拼成正方形}
  var i,j,t1,t2,t3,t4:integer;
  begin
    block:=false;
    fillchar(p,sizeof(p),0);
    for i:=1 to la do p[1+a[i,1],1+a[i,2]]:=1;
    for t1:=1 to n do for t2:=1 to n do if p[t1,t2]=0 then
      begin
        for i:=1 to lb do
          begin
            t3:=t1+b[i,1];t4:=t2+b[i,2];
            if (t3<1) or (t3>n) or (t4<1) or (t4>n) then exit;
            if p[t3,t4]<>0 then exit;
            p[t3,t4]:=2;
          end;
      end;
    block:=true;
  end;

function achieve(la:integer):boolean;
{判断当前的分割方案是否能拼成正方形}
  var i,j,lb,ii,jj:integer;ba,bb:boolean;
  begin
    lb:=0;c:=a;
    for i:=1 to m do for j:=1 to m do
    if source[i,j]=2 then
    begin
      inc(lb);
      b[lb,1]:=i;
      b[lb,2]:=j;
    end;
    {产生A和B部分的各种变化形式}
    for ii:=1 to 2 do
    for i:=1 to 4 do
    begin
	  if (i=1) and (ii=2) then recover(c,la);
      ba:=order(c,la);
      for jj:=1 to 2 do
      for j:=1 to 4 do
        begin
          if (jj=2) and (j=1) then recover(b,lb);
          bb:=order(b,lb);
          if ba then if block(c,la,b,lb) then
            begin
              achieve:=true;
              exit;
            end;
          if bb then if block(b,lb,c,la) then
            begin
              achieve:=true;
              exit;
            end;
          revote(b,lb);
        end;
      revote(c,la);
    end;
    achieve:=false;
  end;

procedure print;{打印结果}
  var i,j:integer;
  begin
    rewrite(fout);
    for i:=1 to m do
      begin
        for j:=1 to m do
        case source[i,j] of
        0:write(fout,'.');
        1:write(fout,'A');
        2:write(fout,'B');
        end;
        writeln(fout);
      end;
    close(fout);
    halt;
  end;

procedure t(k,es:shortint);{搜索过程}
  var i,j,ked,t1,t2,flag:integer;
  begin
    ked:=ep;
    for i:=es+1 to ked do
      begin
        a[k]:=e[i];
        source[a[k,1],a[k,2]]:=1;

        flag:=individual(i,n*n-k);
        if flag=2 then
        begin
          source[a[k,1],a[k,2]]:=2;
          continue;
        end;

        for j:=1 to 4 do
          begin
            t1:=e[i,1]+di[j];
            t2:=e[i,2]+dj[j];
            if (t1<1) or (t2<1) or (t1>m) or (t2>m) then continue;
            if (source[t1,t2]=0) or (extend[t1,t2]<>0) then continue;
            inc(ep);extend[t1,t2]:=k;
            e[ep,1]:=t1;e[ep,2]:=t2;
          end;
        if flag=0 then if achieve(k) then print;
        if k<en then t(k+1,i);

        for j:=ked+1 to ep do
          begin
            extend[e[j,1],e[j,2]]:=0;
          end;
        ep:=ked;
        source[a[k,1],a[k,2]]:=2;
      end;
  end;

begin
  assign(fin,'divide.dat');
  assign(fout,'divide.out');
  reset(fin);
  readln(fin,m);n:=0;
  fillchar(source,sizeof(source),0);
  fillchar(e,sizeof(e),0);
  for i:=1 to m do
    begin
      for j:=1 to m do
        begin
          read(fin,cc);
          if cc='*' then
            begin
              source[i,j]:=2;
              inc(n);
              if e[1,1]=0 then
              begin e[1,1]:=i;e[1,2]:=j; end;
            end;
        end;
      readln(fin);
    end;
  close(fin);
  n:=round(sqrt(n));{初始化工作}
  fillchar(extend,sizeof(extend),0);
  ep:=1;en:=n*n;
  extend[e[1,1],e[1,2]]:=1;
  t(1,0);{搜索}
end.