题解 P1312 【Mayan游戏】

· · 题解

庆祝我的神奇AC,作为一道暴搜题,再合适不过了。

看范围就知道,5x7的矩形,n<=5,3s的限时,暴力的不能再暴力了,然而我在自测的时候最慢的一个点也只有0.8秒

两个字,暴力,就这两个字,消除、下落、判断,全都暴力,遍历图就好,遍历个一两遍都没什么。

可能会稍微有点问题的是怎么判断消除,毕竟横向、竖向都可能会存在消除,其实也简单:遍历一遍图,然后枚举中间点,如果横向或者纵向有三个相同颜色的,就全都标记,最后再遍历一遍图,把标记了的全部清空就好。

var a,f:array[-5..10,-5..10] of longint;//本来不用开这么大也能A的,但是不知道为什么洛谷爆RE了,开大就没事了

    qx,qy,qz:array[1..10] of longint;
    i,j,k,m,n,p,t:longint;
function clean:boolean;
var i,j:longint;
begin
    for i:=0 to 4 do
      for j:=0 to 6 do
        if a[i,j]<>0 then exit(false);
    exit(true);
end;
procedure fall;
var i,j,k:longint;
begin
    for i:=0 to 4 do
      for j:=1 to 6 do
      begin
          if a[i,j]<>0 then
          begin
              k:=j-1;
              while (a[i,k]=0)and(k>=0) do
              begin
                  a[i,k]:=a[i,k+1];
                  a[i,k+1]:=0;
                  dec(k);
              end;
          end;
      end;
end;
function kill:boolean;
var i,j,k:longint;ff:boolean;
begin
    fillchar(f,sizeof(f),0);ff:=false;
    for i:=0 to 4 do
      for j:=0 to 6 do
      begin
          if a[i,j]<>0 then
          begin
              if (j-1>=0)and(a[i,j-1]=a[i,j])and(a[i,j]=a[i,j+1]) then
              begin
                  f[i,j]:=1;f[i,j-1]:=1;f[i,j+1]:=1;
                  ff:=true;
              end;
              if (i-1>=0)and(a[i+1,j]=a[i,j])and(a[i-1,j]=a[i,j]) then
              begin
                  f[i,j]:=1;f[i+1,j]:=1;f[i-1,j]:=1;
                  ff:=true;
              end;
          end;
      end;
    if not ff then exit(false);
    for i:=0 to 4 do
      for j:=0 to 6 do
        if f[i,j]=1 then a[i,j]:=0;
    exit(true);
end;
procedure dfs(c:longint);
var i,j,k:longint;b:array[-5..10,-5..10] of longint;
begin
    if c=n+1 then
    begin
        if clean then
        begin
            for i:=1 to n do
              writeln(qx[i],' ',qy[i],' ',qz[i]);
            halt;
        end;
        exit;
    end;
    b:=a;
    for i:=0 to 4 do
      for j:=0 to 6 do
      begin
          if a[i,j]<>0 then
          begin
              if (a[i+1,j]<>a[i,j])and(i+1<=4) then
              begin
                  k:=a[i+1,j];
                  a[i+1,j]:=a[i,j];
                  a[i,j]:=k;
                  qx[c]:=i;qy[c]:=j;qz[c]:=1;
                  fall;
                  while kill do fall;
                  dfs(c+1);
                  a:=b;
              end;
              if (i-1>=0)and(a[i-1,j]=0) then
              begin
                  k:=a[i-1,j];
                  a[i-1,j]:=a[i,j];
                  a[i,j]:=k;
                  qx[c]:=i;qy[c]:=j;qz[c]:=-1;
                  fall;
                  while kill do fall;
                  dfs(c+1);
                  a:=b;
              end;
          end;
          a:=b;
      end;
end;
begin
    readln(n);
    for i:=0 to 4 do
    begin
        read(p);t:=-1;
        while p<>0 do
        begin
            inc(t);
            a[i,t]:=p;
            read(p);
        end;
    end;
    dfs(1);
    writeln(-1);
end.