Thuật toán sudoku

Tiêu đề: Thuật toán sudoku 28/07/09, 06:18 pm

Mình đã viết xong chương trình sodoku bằng pascal. Thuật giải cũng rất đơn giản nhưng vì tối ưu thời gian giải nên cấu trúc chương trình khá phức tạp. Nếu như ai đó nói Đệ qui quay lui thì coi chừng sai lầm đó. Mình cũng thử rồi, nhưng solve tới >15p (ặc ặc).
Thuật toán mình như sau:
Nhập dữ liệu vào mảng 2 chiều sdk[1..9,1..9] of byte; Set sdk[i,j] := 0
1. Đánh dấu hàng và cột bằng mảng: r[1..9,1..9] và c[1..9,1..9] of boolean
Kiểm tra 1 vị trí trên mảng sdk, nếu tồn tại sdk[i,j]> 0 :
[/indent]r[j,sdk[i,j]]:=true: TRên hàng đó đã có số sdk[i,j]
[indent][/indentc]r[sdk[i,j],i]:=true: TRên hàng đó đã có số sdk[i,j]
2. Đánh dấu mảng 3*3 chứa sdk[i,j] bằng mảng m[1..3,1..3,1..9] of boolean
[indent]
if sdk[i,j]> then m[(i div 3)+1,(j div 3) +1, sdk[i,j]]:=true;
2. Xử lý :
2.1 Dùng 3 procedure kiểm tra: Nếu trên 1 hàng hoặc 1 cột hoặc 1 mảng 3*3 mà tồn tại duy nhất 1 vị trí của số nào đó thì đặt nó vào, quay lại bước 1. Repeat cho đến khi ko có giá trị thay đổi (Ko có số nào được đặt vào.
procedure check_ROW(row,col:tp);
var i,j,k,coltmp,rowtmp,count,numtmp:tp;
a:array[1..9] of boolean;
begin
if sdk[row,col]>0 then exit;
count:=0;
coltmp:=0;
rowtmp:=0;
for i:=1 to n do a[i]:=true;
for i:=1 to n do
a[sdk[row,i]]:=false;

for i:=1 to n do {check col de so sanh logic}
a[sdk[i,row]]:=false;
for i:=1 to n do
if a[i]= true then
begin
inc(count);
numtmp:=i;
coltmp:=col;

end;
if (count=1) then
begin
sdk[row,col]:=numtmp;
RESET_Matrix;
savepos[row,col]:=true;
inc(Numsolved);
writeln('a[',row,' ',col,']=',numtmp);
end;

procedure check_COL(row,col:tp);
var i,j,k,coltmp,rowtmp,count,numtmp:tp;
a:array[1..9] of boolean;
begin
if sdk[row,col]>0 then exit;
count:=0;
coltmp:=0;
rowtmp:=0;
for i:=1 to n do a[i]:=true;
for i:=1 to n do
a[sdk[i,col]]:=false;

for i:=1 to n do {check col de so sanh logic}
a[sdk[col,i]]:=false;
for i:=1 to n do
if a[i]= true then
begin
inc(count);
numtmp:=i;
coltmp:=col;

end;
if (count=1) then
begin
sdk[row,col]:=numtmp;
RESET_Matrix;
savepos[row,col]:=true;
inc(Numsolved);
end;
end;

end;
procedure Check_Square(col,row,Num:tp); { Kiem tra kich thuoc 3x3}
var i,j,k,count,rowtmp,coltmp:tp;
begin
count:=0;
rowtmp:=0;
coltmp:=0;
for i:=1 to 3 do
for j:=1 to 3 do
if chk[col*3+i,row*3+j,num]=true then
begin
count:=count+1;
rowtmp:=row*3+j;
coltmp:=col*3+i;
end;
if count=1 then

begin
sdk[coltmp,rowtmp]:=Num;
savepos[coltmp,rowtmp]:=true;
RESET_matrix;
inc(Numsolved);
end;
end;

2.2 Sau khi xử lý bước 2.1 mà ma trận vẫn chưa full, ta mới dùng đệ qui:
2.2.1. Set 1 mảng bao gồm các vị trí có khả năng đặt tại 1 ô trống trên sdk:
pa[1..81, 1..9] of byte; (Lúc này ta bẻ mảng 9*9 thành mảng 1 chiều 81 đơn vị)
(Position availble num)
pac[1..81] of byte: Lưu lại số các số có khả năng đặt tại vị trí sdk[i,j]=0 (Position availble count)
p:=0;
for i:=1 to n do
for j:=1 to n do
if sdk[i,j]=0 then
begin
p:=p+1;
count:=0;
for k:=1 to n do
if (r[i,k]=true) and (c[k,j]=true) and (m[((i-1) div 3)+1,((j-1) div 3)+1,k]=true) then
begin
count2:=count+1;
pa[p,count]:=k;
pac[p]:=count;
end;

end;
2.2.3 Viết 1 procedure Set lại ma trận sau khi đặt 1 số và 1 Unreset khi ta lấy số đi, cần thiết cho Đệ qui và quay lui:
procedure RESET_BB(row,col,num:tp);
var i,j,p,q:tp;
begin
r[row,num]:=false;
c[num,col]:=false;
p:=((row-1) div 3)+1; { Tinh tien ma tran len 1 bac cho phu hop voi TYPE}
q:=((col-1) div 3)+1;
m[p,q,num]:=false;
end;
procedure UNRESET_BB(row,col,num:tp);
var i,j,p,q:tp;
begin
r[row,num]:=true;
c[num,col]:=true;
p:=((row-1) div 3)+1;
q:=((col-1) div 3)+1;
m[p,q,num]:=true;
end;

2.2.4 Đệ qui quay lui:
procedure BackBreak(cur:byte);
var i:tp;
begin
if (cur>count) then
begin
writeln('------------------');
output;
halt;
end;
for i:=1 to pac[cur] do
begin
if (r[rs[cur],pa[cur,i]]=true) and (c[pa[cur,i],cs[cur]]) then
begin
savepos[rs[cur],cs[cur]]:=true;
sdk[rs[cur],cs[cur]]:=pa[cur,i];
inc(numsolved);
reset_BB(rs[cur],cs[cur],pa[cur,i]);
backbreak(cur+1);
dec(numsolved);
sdk[rs[cur],cs[cur]]:=0;
UNRESET_BB(rs[cur],cs[cur],pa[cur,i]);
end;
end;
end;
2.2.5 Còn đây là phần kết hợp các module trên để giải quyết bài toán:
procedure SOLVE;
var i,j,k,num1,num2,num3,num:tp;
begin
repeat
num:=numsolved;
repeat
num1:=numsolved;
writeln('Checking square....');
for i:=0 to 2 do
for j:=0 to 2 do
for k:=1 to n do

check_square(i,j,k);
until (Num1=numsolved)or(numsolved=81){or(keypressed)};
repeat
num2:=numsolved;
writeln('Checking row....');
for i:=1 to n do
for j:=1 to n do
check_ROW(i,j);

until (Num2=numsolved)or(numsolved=81);{or(keypressed);}
repeat
num3:=numsolved;
writeln('Checking col....');
for i:=1 to n do
for j:=1 to n do
check_COL(i,j);
until (Num3=numsolved)or(numsolved=81);
until (numsolved=num)or(numsolved=81);{or(keypressed);}
if numsolved=81 then exit else
begin
writeln('Back breaking....');
INIT_BB;
BackBreak(1);
end;
end;
---------------------------------------------
Mình đã test thành công các bài trên trang 24h.com mà không cần đệ qui. Chỉ có các bài sodoku rất khó mới dùng tới đệ qui và kết quả ko tới 0.1s . Nay mong các bạn đóng ghóp các bài sodoku khó để mình hoàn thiện chương trình. Thân.