noip2011 day1-3 Mayan游戏

　Mayan puzzle是最近流行起来的一个游戏。游戏界面是一个 7 行5 列的棋盘，上面堆放着一些方块，方块不能悬空堆放，即方块必须放在最下面一行，或者放在其他方块之上。游戏通关是指在规定的步数内消除所有的方块，消除方块的规则如下： 
　　1 、每步移动可以且仅可以沿横向（即向左或向右）拖动某一方块一格：当拖动这一方块时，如果拖动后到达的位置（以下称目标位置）也有方块，那么这两个方块将交换位置（参见输入输出样例说明中的图6 到图7 ）；如果目标位置上没有方块，那么被拖动的方块将从原来的竖列中抽出，并从目标位置上掉落（直到不悬空，参见下面图1 和图2）；
 
　　2 、任一时刻，如果在一横行或者竖列上有连续三个或者三个以上相同颜色的方块，则它们将立即被消除（参见图1 到图3）。 

　　注意： 
　　a) 如果同时有多组方块满足消除条件，几组方块会同时被消除（例如下面图4 ，三个颜色为1 的方块和三个颜色为 2 的方块会同时被消除，最后剩下一个颜色为 2 的方块）。 
　　b) 当出现行和列都满足消除条件且行列共享某个方块时，行和列上满足消除条件的所有方块会被同时消除（例如下面图5 所示的情形，5 个方块会同时被消除）。  
　　3 、方块消除之后，消除位置之上的方块将掉落，掉落后可能会引起新的方块消除。注意：掉落的过程中将不会有方块的消除。 
　　上面图1 到图 3 给出了在棋盘上移动一块方块之后棋盘的变化。棋盘的左下角方块的坐标为（0, 0 ），将位于（3, 3 ）的方块向左移动之后，游戏界面从图 1 变成图 2 所示的状态，此时在一竖列上有连续三块颜色为4 的方块，满足消除条件，消除连续3 块颜色为4 的方块后，上方的颜色为3 的方块掉落，形成图 3 所示的局面。

输入格式：
　　输入文件mayan.in，共 6 行。 
　　第一行为一个正整数n ，表示要求游戏通关的步数。 
　　接下来的5 行，描述 7*5 的游戏界面。每行若干个整数，每两个整数之间用一个空格隔开，每行以一个0 结束，自下向上表示每竖列方块的颜色编号（颜色不多于10种，从1 开始顺序编号，相同数字表示相同颜色）。 
输入数据保证初始棋盘中没有可以消除的方块。
输出格式：
　　输出文件名为mayan.out。 
　　如果有解决方案，输出 n 行，每行包含 3 个整数x，y，g ，表示一次移动，每两个整数之间用一个空格隔开，其中（x ，y）表示要移动的方块的坐标，g 表示移动的方向，1 表示向右移动，-1表示向左移动。注意：多组解时，按照 x 为第一关健字，y 为第二关健字，1优先于-1 ，给出一组字典序最小的解。游戏界面左下角的坐标为（0 ，0 ）。 
　　如果没有解决方案，输出一行，包含一个整数-1。

input

3
1 0
2 1 0
2 3 4 0
3 1 0
2 4 3 4 0

output

2 1 1
3 1 1
3 0 1【输入输出样例说明】 

按箭头方向的顺序分别为图6 到图11 

样例输入的游戏局面如上面第一个图片所示，依次移动的三步是：（2 ，1 ）处的方格向右移动，（3，1 ）处的方格向右移动，（3 ，0）处的方格向右移动，最后可以将棋盘上所有方块消除。 
【数据范围】 
对于30% 的数据，初始棋盘上的方块都在棋盘的最下面一行； 
对于100%的数据，0 < n≤5 。 

var a:array[0..4,-1..6]of longint;
p:array[1..100,1..2]of longint;
step:array[1..5,1..3]of longint;
n,i,j,x,y:longint;
flag:boolean;
procedure down;
var i,j,t,x,y:longint;
begin
  for i:=0 to 4 do
  for j:=1 to 6 do
  if (a[i,j]<>0)and(a[i,j-1]=0) then
  begin
    x:=i;
    y:=j;
    while(a[x,y-1]=0)and(y<>0)do
    begin
      t:=a[x,y];
      a[x,y]:=0;
      a[x,y-1]:=t;
      dec(y);
    end;
  end;
end;
procedure wwj;
var i,j,w:longint;
begin
  w:=0;
  for i:=0 to 4 do
  for j:=0 to 6 do
  if a[i,j]<>0 then
  begin
    if (i+2<=4) then
    begin
      if(a[i,j]=a[i+1,j])and(a[i+1,j]=a[i+2,j]) then
      begin
        inc(w);
        p[w,1]:=i;
        p[w,2]:=j;
        inc(w);
        p[w,1]:=i+1;
        p[w,2]:=j;
        inc(w);
        p[w,1]:=i+2;
        p[w,2]:=j;
      end;
    end;
    if (j+2<=6) then
    begin
      if(a[i,j]=a[i,j+1])and(a[i,j+1]=a[i,j+2]) then
      begin
        inc(w);
        p[w,1]:=i;
        p[w,2]:=j;
        inc(w);
        p[w,1]:=i;
        p[w,2]:=j+1;
        inc(w);
        p[w,1]:=i;
        p[w,2]:=j+2;
      end;
    end;
  end;
  for i:=1 to w do a[p[i,1],p[i,2]]:=0;
  if w=0 then flag:=false else down;
end;
procedure dfs(k:longint);
var i,j,t:longint;
b:array[0..4,-1..6]of longint;
begin
  if k>n then
  begin
    for i:=0 to 4 do
    for j:=0 to 6 do
    if a[i,j]<>0 then exit;
    for i:=1 to n do writeln(step[i,1],' ',step[i,2],' ',step[i,3]);
    halt;
  end;
  for i:=0 to 4 do
  for j:=0 to 6 do
  if a[i,j]<>0 then
  begin
    if(i+1<=4)and(a[i,j]<>a[i+1,j]) then
    begin
      flag:=true;
      b:=a;
      t:=a[i,j];
      a[i,j]:=a[i+1,j];
      a[i+1,j]:=t;
      step[k,1]:=i;
      step[k,2]:=j;
      step[k,3]:=1;
      if a[i,j]=0 then down;
      while flag do wwj;
      dfs(k+1);
      a:=b;
    end;
    if i-1>=0 then
    begin
      if a[i-1,j]=0 then
      begin
        flag:=true;
        b:=a;
        t:=a[i,j];
        a[i,j]:=a[i-1,j];
        a[i-1,j]:=t;
        step[k,1]:=i;
        step[k,2]:=j;
        step[k,3]:=-1;
        down;
        while flag do wwj;
        dfs(k+1);
        a:=b;
      end;
    end;
  end;
end;
begin
  readln(n);
  for i:=0 to 4 do
  begin
    y:=0;
    read(x);
    while x<>0 do
    begin
      a[i,y]:=x;
      inc(y);
      read(x);
    end;
    readln;
  end;
  dfs(1);
  write('-1');
end.