Click đây để đến diễn đàn mới
 
PortalIndexGalleryTrợ giúpĐăng kýĐăng Nhập

Share | 
 

 Thuat toan giai SuDoKu

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giảThông điệp
Angel9999
Thành viên năng nổ
Thành viên năng nổ


Nam
Tổng số bài gửi : 26
Age : 23
Nơi ở : Quan6
Nghề nghiệp, trường lớp : duong nhien la` HS
Sở thích : doc truyen
Tâm trạng :
Thú nuôi :
Cảnh cáo :
0 / 1000 / 100

Registration date : 25/12/2007

Bài gửiTiêu đề: Thuat toan giai SuDoKu   25/12/2007, 1:55 pm

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!!!
Về Đầu Trang Go down
Xem lý lịch thành viên
Khách v
Khách viếng thăm



Bài gửiTiêu đề: Re: Thuat toan giai SuDoKu   25/12/2007, 4:42 pm

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ỉ ?


Được sửa bởi ngày 25/12/2007, 4:46 pm; sửa lần 1.
Về Đầu Trang Go down
duy_huy2008
Thành viên năng nổ
Thành viên năng nổ


Nam
Tổng số bài gửi : 30
Age : 22
Nơi ở : Tây Ninh
Nghề nghiệp, trường lớp : Tester - Moder - Coder - Viper - Học sinh ^^
Sở thích : Lập trình
Tâm trạng :
Thú nuôi :
Cảnh cáo :
0 / 1000 / 100

Registration date : 20/12/2007

Bài gửiTiêu đề: Re: Thuat toan giai SuDoKu   25/12/2007, 4:44 pm

Sao không Post đại một ví dụ đi, code gì lung tung thế này :shock:
Về Đầu Trang Go down
Xem lý lịch thành viên http://duyhuy2008.googlepages.com/home
Angel9999
Thành viên năng nổ
Thành viên năng nổ


Nam
Tổng số bài gửi : 26
Age : 23
Nơi ở : Quan6
Nghề nghiệp, trường lớp : duong nhien la` HS
Sở thích : doc truyen
Tâm trạng :
Thú nuôi :
Cảnh cáo :
0 / 1000 / 100

Registration date : 25/12/2007

Bài gửiTiêu đề: Re: Thuat toan giai SuDoKu   27/12/2007, 8:20 pm

ac code vay ma lung tung ah` Too Sad
chinh lai cho co hang ngu la dc roai` !!!!!!!!! Angry
Về Đầu Trang Go down
Xem lý lịch thành viên
Sponsored content




Bài gửiTiêu đề: Re: Thuat toan giai SuDoKu   

Về Đầu Trang Go down
 
Thuat toan giai SuDoKu
Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang
 Similar topics
-
» Vệ sinh tàu & sơn trên tàu
» Giúp Mình làm lập đồ giải tránh Va
» Từ con diều giấy đến chiếc máy vi tính
» Tìm hiểu về "Tứ sát” và cách hóa giải
» Vô hình ...

Permissions in this forum:Bạn không có quyền trả lời bài viết
LAM SƠN :: Học tâp :: Tin Học :: Lập trình Pascal-
Chuyển đến