搜索 MAYAN

原題：NOIP 2011 MAYAN

類型：搜索 （小剪枝），不是很難

program mayan;
type
byte=integer;
    state=array[1..5,1..7]of byte;
    oper=object
	a,b,c:array[1..5]of byte;
	procedure push(d,x,y,t:byte);
	procedure print;
    end;
var limit:byte; a:state; o:oper;
procedure oper.push(d,x,y,t:byte);
begin
    a[d]:=x; b[d]:=y; c[d]:=t;
end;
procedure oper.print; var i:byte;
begin
    for i:=1 to limit do
	writeln(a[i]-1,' ',b[i]-1,' ',2-c[i]);
    close(input);close(output);halt;
end;

var mark:array[1..5,1..7]of boolean;
function drop(var a:state;var tot:byte):boolean; var i,j:byte;
begin
    fillchar(mark,sizeof(mark),0); drop:=false;
    for i:=3 to 5 do
	for j:=1 to 7 do
            if a[i][j]>0 then
	    if (a[i][j]=a[i-1][j])and(a[i][j]=a[i-2][j]) then begin
		mark[i][j]:=true;
		mark[i-1][j]:=true;
		mark[i-2][j]:=true;
		drop:=true;
	    end;
    for i:=1 to 5 do
	for j:=3 to 7 do
            if a[i][j]>0 then
	    if (a[i][j]=a[i][j-1])and(a[i][j]=a[i][j-2]) then begin
		mark[i][j]:=true;
		mark[i][j-1]:=true;
		mark[i][j-2]:=true;
		drop:=true;
	    end;
    for i:=1 to 5 do
	for j:=1 to 7 do
	    if mark[i][j] then begin a[i][j]:=0; dec(tot); end;
end;

procedure del(var a:state);
var g:array[1..7]of byte; i,j,t:byte;
begin
    for i:=1 to 5 do begin
	t:=0;
	move(a[i],g,sizeof(g));
	fillchar(a[i],sizeof(a[i]),0);
	for j:=1 to 7 do if g[j]>0 then begin
	    inc(t); a[i][t]:=g[j];
	end;
    end;
end;

procedure dfs(const dep:byte; const a:state; const tot:byte);
var tmp:state; tt:byte; i,j:byte;
    procedure swap(var i,j:byte);var t:byte;
    begin t:=i; i:=j; j:=t; end;
begin
    if dep=limit then
        if tot=0 then o.print else exit;
    for i:=1 to 5 do
	for j:=1 to 7 do if a[i][j]>0 then begin
	    if i<5 then begin
		if a[i][j]=a[i+1][j] then continue;
		move(a,tmp,sizeof(a)); tt:=tot;
		swap(tmp[i][j],tmp[i+1][j]);del(tmp);
		while drop(tmp,tt) do del(tmp);
		o.push(dep+1,i,j,1);
		dfs(dep+1,tmp,tt);
	    end;
	    if i>1 then begin
		if a[i][j]=a[i-1][j] then continue;
		if (a[i-1][j]>0)and(a[i][j]>0) then continue;
		move(a,tmp,sizeof(a)); tt:=tot;
		swap(tmp[i][j],tmp[i-1][j]);del(tmp);
		while drop(tmp,tt) do del(tmp);
		o.push(dep+1,i,j,3);
		dfs(dep+1,tmp,tt);
	    end;
	end;
end;

var i,j,t:byte;
begin
    assign(input,'mayan.in');reset(input);
    assign(output,'mayan.out');rewrite(output);
    readln(limit); t:=0;
    for i:=1 to 5 do begin
	for j:=1 to 7 do begin
	    read(a[i][j]);
	    if a[i][j]=0 then break else inc(t);
	end;readln;
    end;
    Dfs(0,a,t);writeln(-1);
end.