加密网格

题目见<<算法艺术与信息学竞赛>>

program jiami;
const
  maxn=10;
type
  sta=record
       x,y:integer;
       end;

var
    map,m2,tar:array[1..maxn*2,1..maxn*2]of char;
    q:array[1..maxn]of sta;
    boo:array[1..maxn*maxn*4]of boolean;
    che:array[1..maxn*2,1..maxn*2]of boolean;
    nx,ny,n,i,j:longint;
    flag:boolean;

function can:boolean;
var
 i,j,k,mm:longint;
 kk:string;
begin
    can:=true;
    mm:=0;
    for k:=1 to 4 do
     begin

         for i:=1 to 2*n do
          for j:=1 to 2*n do
           begin
              str(k,kk);
              if m2[i,j]=kk then
               begin
                   inc(mm);
                   nx:=(mm div (2*n))+1;ny:=mm mod (2*n);
                   if ny=0 then begin ny:=2*n;nx:=nx-1;end;

                   if map[nx,ny]<>tar[i,j] then exit(false);
                   //按照加密版的规则产生的结果是否与题给answer一致
               end;
           end;
     end;
end;

function check:boolean;
var
  i,j:integer;
begin
        check:=true;
       fillchar(che,sizeof(che),0);
       //检验所求模版每一个格子是否满足条件 同时加上标记
       for i:=1 to n*n do
        begin
            nx:=q[i].x;ny:=q[i].y;
            if ny=0 then begin ny:=2*n;nx:=nx-1;end;

            if not che[nx,ny] then
              begin
                che[nx,ny]:=true;
                m2[nx,ny]:='1';
                //1 代表对应坐标是没有旋转的第一次填数中的点
              end else exit(false);
            if not che[ny,2*n+1-nx]then
                begin
                  che[ny,2*n+1-nx]:=true;
                  m2[ny,2*n+1-nx]:='2';
                  //2 代表旋转90度后的第二次填数中的点
                end else exit(false);
            if not che[n*2+1-nx,n*2+1-ny] then
               begin
                che[n*2+1-nx,n*2+1-ny]:=true;
                m2[n*2+1-nx,n*2+1-ny]:='3';
                //3 代表旋转180度后的第三次填数中的点
               end else exit(false);
            if not che[n*2+1-ny,nx] then
              begin
               che[n*2+1-ny,nx]:=true;
               m2[n*2+1-ny,nx]:='4';
               //4代表旋转270度后的第四次填数中的点
              end else exit(false);
        end;

       if (not can) then exit(false);
end;

procedure print;
var
 i,j:longint;
begin
      for i:=1 to 2*n do
       begin
        for j:=1 to 2*n do
         if m2[i,j]='1' then write('*')else write('.');
         writeln;
       end;
end;

procedure play(d,k:longint);
var
 i,j:integer;
begin
    if d=n*n+1 then
     if check then
      begin
           print;halt;
      end else exit;

    for i:=k to 4*n*n-(n*n-(d-1)) do
    if boo[i] then
     begin
        boo[i]:=false;
        nx:=(i div (n*2))+1;ny:=i mod (n*2);
        if ny=0 then begin ny:=2*n; nx:=nx-1;end;

        q[d].x:=nx;q[d].y:=ny;
        play(d+1,i+1);
        boo[i]:=true;
     end;
end;

begin
    assign(input,'win.in');
    assign(output,'win.out');
    reset(input);
    rewrite(output);

    readln(n);
    for i:=1 to 2*n do
     begin
       for j:=1 to 2*n do  read(map[i,j]);readln;
     end;
    for i:=1 to 2*n do
     begin
       for j:=1 to 2*n do  read(tar[i,j]);readln;
     end;

    fillchar(boo,sizeof(boo),1);

    //xuan zhuan  shi ziji
    for i:=1 to n*n*4 do
    begin
         nx:=(i div (n*2))+1;ny:=i mod (n*2);
         if ny=0 then begin ny:=n*2;nx:=nx-1;end;

         if (ny=2*n+1-nx)and(nx=ny)then boo[i]:=false;
    end;

    //main
    play(1,1);

    close(input);
    close(output);


end.