Thuat toan giai SuDoKu

Ai có hứng thú với bộ môn SuDoKu mà cần đáp án để coi thì xin mời chạy thử chương trình sau được viết trên ngôn ngữ lập trình Borland Pascal 7.0

program giai_sudoku;
type sudoku=array[1..9,1..9]of integer;
o_trong=record
x,y:integer;
chua_co:string[9];
end;
mang=array[1..9] of integer;
var ok:char;
buoc:integer;
okm:boolean;
lv:sudoku;

function kiem_tra_socap(b:mang):boolean;
var d,i1,j1:integer;
kq1:boolean;
begin
d:=0;
for i1:=1 to 8 do
for j1:=i1+1 to 9 do
if b[i1]<>0 then
if b[i1]=b[j1] then d:=d+1;
if d=0 then kq1:=true
else kq1:=false;
kiem_tra_socap:=kq1;
end;

function kiem_tra(c:sudoku):boolean;
var f:mang;
kq:boolean;
z,i2,j2,m1,n1,t1,pn,qn,p1,p2,q1,q2:integer;
begin
m1:=0;
n1:=0;
t1:=0;
for i2:=1 to 9 do
begin
for j2:=1 to 9 do f[j2]:=c[i2,j2];
if (not kiem_tra_socap(f)) then m1:=m1+1
end;
for j2:=1 to 9 do
begin
for i2:=1 to 9 do f[i2]:=c[i2,j2];
if (not kiem_tra_socap(f)) then n1:=n1+1
end;
for pn:=0 to 2 do for qn:=0 to 2 do
begin
z:=1;
p1:=3*pn+1;p2:=3*pn+3;
q1:=3*qn+1;q2:=3*qn+3;
for i2:=p1 to p2 do for j2:=q1 to q2 do begin f[z]:=c[i2,j2];z:=z+1 end;
if (not kiem_tra_socap(f)) then t1:=t1+1
end;
if m1+n1+t1=0 then kq:=true
else kq:=false;
kiem_tra:=kq;
end;

procedure xuat(a:sudoku;okay:boolean);
var i,j:integer;
tg:char;
begin
if okay then
for i:=0 to 9 do
begin
if i=0 then
begin
for j:=0 to 8 do begin if j=0 then write(' ':9) else write(j,' ');end;
writeln('9 ');
end
else
for j:=0 to 9 do
begin
if a[i,j]=0 then tg:=' '
else tg:=chr(a[i,j]+48);
if j=9 then writeln('| ',tg,' |')
else if j=0 then write(' ':6,i) else write('| ',tg,' ');
end;
writeln(' ':7,'+---+---+---+---+---+---+---+---+---+');
end
else writeln('sudoku khong duoc giai');
end;

procedure ran(var g:integer);
begin
repeat
g:=random(10);
if g<>0 then break;
until false;
end;
procedure giai(var a:sudoku;var w1:boolean);
var mang_o_trong:array[1..81]of o_trong;
so_o_trong:integer;
i,j,k,l,m,n,p,q,t,dem:integer;
begin
k:=0;
for i:=1 to 9 do for j:=1 to 9 do if a[i,j]=0 then
begin
k:=k+1;
with mang_o_trong[k] do
begin
x:=i;y:=j;
chua_co:='123456789';
for t:=1 to 9 do
begin
if a[i,t]<>0 then for l:=1 to length(chua_co) do
if a[i,t]=ord(chua_co[l])-48 then chua_co[l]:='0';
if a[j,t]<>0 then for l:=1 to length(chua_co) do
if a[j,t]=ord(chua_co[l])-48 then chua_co[l]:='0';
end;
for m:=0 to 2 do for n:=0 to 2 do
if (i>=3*m+1)and(i<=3*m+3) then if (j>=3*n+1)and(j<=3*n+3) then
begin
t:=0 ;
for p:=3*m+1 to 3*m+3 do for q:=3*n+1 to 3*n+3 do
for l:=1 to length(chua_co) do
if a[p,q]=ord(chua_co[l])-48 then chua_co[l]:='0';
end;
end;
end;
so_o_trong:=k;
k:=1;
dem:=0;
while (k>=1)and(k<=so_o_trong) do with mang_o_trong[k] do
begin
l:=0;
repeat
l:=l+1;
if chua_co[l]<>'0' then begin if a[x,y]=9 then begin a[x,y]:=0;k:=k-2;break end
else a[x,y]:=a[x,y]+1;end;
dem:=dem+1;
until (kiem_tra(a)and(chua_co[l]<>'0'))or(dem=20000);
k:=k+1;
end;
if (k=0)or(dem=20000) then w1:=false
else w1:=true;
end;
procedure tao(var a:sudoku);
var i,j,k,w,d1:integer;
okay:boolean;
str:string[9];
begin
randomize;
for i:=1 to 9 do
for j:=1 to 9 do a[i,j]:=0;
writeln;
write('Hay cho do kho cua sudoku (tuong ung voi so o con trong):');
readln(w);
Repeat
for k:=1 to 10 do
begin
ran(i);
ran(j);
if a[i,j]=0 then
repeat
ran(a[i,j]);
until kiem_tra(a);
end;
giai(a,okay);
Until okay;
writeln('day la sudoku dc cho ban dau' );
xuat(a,true);
for k:=1 to w do
repeat
ran(i);ran(j);
if a[i,j]<>0 then begin a[i,j]:=0 ;break end
until false;
writeln('Day la sudoku phai giai:');
end;
procedure nhap(var a:sudoku);
var i,j:integer;
st:string;
begin
writeln;
writeln;
writeln;
writeln;
writeln(' HAY NHAP SUDOKU BAN MUON GIAI VAO ');
writeln;
writeln('* Chu y:- Nhap tu trai qua phai,tu tren xuong duoi;');
writeln(' - O nao trong thi an "ENTER" luon');
writeln;
for i:=1 to 9 do for j:=1 to 9 do
repeat
write(' a[',i,',',j,']=');readln(st);
repeat
if st[length(st)]=' ' then delete(st,length(st)-1,1);
until st[length(st)]<>' ';
if length(st)>1 then writeln('so ban vua nhap ko hop le,hay nhap lai')
else
begin
if st='' then a[i,j]:=0
else a[i,j]:=ord(st[1])-48;
break
end;
until false;
end;
procedure edit(var a:sudoku);
var i,j:integer;
begin
write('nhap so hang vao: i=');readln(i);
write('nhap so cot vao : j=');readln(j);
write('ban muon sua a[',i,',',j,'] thanh:');readln(a[i,j]);
end;
function ketthuc(a:sudoku):boolean;
var i,j,d:integer;
kqkt:boolean;
begin
d:=0;
for i:=1 to 9 do
for j:=1 to 9 do if a[i,j]=0 then d:=d+1;
if d=0 then kqkt:=true
else kqkt:=false;
ketthuc:=kqkt;
end;
BEGIN
writeln('1/ Ban muon lam gi :+ Nhap sudoku vao de nho may giai ho (an phim "1")');
writeln(' + Nho may ra de roi giai tren may (an phim "2")');
writeln;
write('2/ Lua chon cua ban:');readln(ok);
case ok of
'1':begin
nhap(lv);
repeat
writeln('sudoku ban muon giai co dang:');
xuat(lv,true);
write('ban co muon chinh sua gi ko y/n?:');readln(ok);
if ok='y' then edit(lv);
until ok='n';
write('nhan "ENTER" de tiep tuc');readln;
giai(lv,okm);
writeln(' Loi giai cua sudoku la:');
xuat(lv,okm)
end;
'2':begin
buoc:=0;
tao(lv);
repeat
xuat(lv,true);
edit(lv);
buoc:=buoc+1;
until ketthuc(lv);
xuat(lv,true);
if kiem_tra(lv) then writeln('ban ket thuc sudoku voi ',buoc,' buoc di')
else
begin
writeln('ban khong hoan thanh sudoku');
xuat(lv,true);
end;
end;
'3':begin
tao(lv);
xuat(lv,true);
giai(lv,okm);
writeln('loi giai cua sudoku la:');
xuat(lv,okm);
end;
end;
readln;
END.

Mong các bạn góp ý cho bài viết trên có gì chỉ giáo nha!!(tui mới post bài lần đầu) :confused:
Tui di ngủ nha (Trưa roài) :sleep:
Chúc các bạn giải SuDoKu hay hơn nha bibi!!!

Nhận xét: Code viết không có hàng ngũ gì cả, khó kiểm tra.
Không biết bạn "chôm" hay là tự làm nhỉ ?

Sao không Post đại một ví dụ đi, code gì lung tung thế này :shock:

ac code vay ma lung tung ah`
chinh lai cho co hang ngu la dc roai` !!!!!!!!!