讨论 / 不断地改进
crisbo 2012-07-20 02:10:00
点我顶贴 收藏 删除
type

tt=array[0..5,0..7] of byte;

const

om1=1048575;

om2=11;

var

s:tt;

n,i,j,cc,k,e,u:byte;

x,y,d:array[0..4] of shortint;

p:array[0..4,0..6] of boolean;

h:array[0..4,0..om1] of longint;

w,g:longint;

function hash(num:byte):boolean;

begin

w:=0;

for i:=0 to 4 do

for j:=0 to 6 do

w:=(w*11+s[i,j])AND om1;

IF W=0 THEN EXIT(TRUE);

g:=w;

while (h[num,g]<>0)and(h[num,g]<>w) do g:=(g+om2)AND om1;

hash:=true;

if h[num,g]=w then

hash:=false;

h[num,g]:=w;

end;

function check:byte;

begin

check:=0;

fillchar(p,sizeof(p),true);

for i:=0 to 4 do

for j:=0 to 6 do

if s[i,j]=0 then break else

begin

k:=j+1;

while s[i,k]=s[i,j] do inc(k);

if k-j>=3 then

for e:=j to k-1 do p[i,e]:=false;

k:=i+1;

while s[k,j]=s[i,j] do inc(k);

if k-i>=3 then

for e:=i to k-1 do p[e,j]:=false;

end;

for i:=0 to 4 do

begin

e:=0;

for j:=0 to 6 do

if s[i,j]=0 then break else

begin

k:=s[i,j];s[i,j]:=0;

if p[i,j] then

begin s[i,e]:=k;inc(e);end;

end;

check:=check+e;

end;

end;

procedure find(num,cc:byte);

var i,j,k,f:byte; q:tt;

begin

if num=n then

if cc=0 then

begin

for i:=0 to n-1 do writeln(x[i],' ',y[i],' ',d[i]);

halt;

end else exit;

q:=s;

for i:=0 to 4 do

for j:=0 to 6 do

if q[i,j]=0 then BREAK ELSE

begin

if (i<4)and(q[i,j]<>q[i+1,j]) then

begin

x[num]:=i;y[num]:=j;d[num]:=1;

s:=q;k:=cc;

if s[i+1,j]<>0 then

begin u:=s[i,j];s[i,j]:=s[i+1,j];s[i+1,j]:=u; end else

begin u:=0;while s[i+1,u]>0 do inc(u);s[i+1,u]:=s[i,j];

for u:=j to 5 do s[i,u]:=s[i,u+1];end;

f:=check;

while f<k do begin k:=f;f:=check;end;

if hash(num) then find(num+1,f);

end;

if (i>0)and(q[i-1,j]=0) then

begin

x[num]:=i;y[num]:=j;d[num]:=-1;

s:=q;k:=cc;

u:=0;while s[i-1,u]>0 do inc(u);s[i-1,u]:=s[i,j];

for u:=j to 5 do s[i,u]:=s[i,u+1];

f:=check;

while f<k do begin k:=f;f:=check;end;

if hash(num) then find(num+1,f);

end;

end;

end;

begin

readln(n);cc:=0;

fillchar(s,sizeof(s),0);

for i:=0 to 5 do s[i,7]:=15;

for i:=0 to 7 do s[5,i]:=15;

for i:=0 to 4 do

begin

read(s[i,0]);

j:=0;

while s[i,j]<>0 do begin inc(j);read(s[i,j]);end;

cc:=cc+j;

readln;

end;

find(0,cc);

writeln(-1);

end.

#1 crisbo@2012-07-20 02:10:00
回复 删除
789545 2656ms [Show Status] [From crisbo] [PID:656] FP Xeond[6] 2012-7-20 17:05:00
查看更多回复
提交回复